home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tjgold.zip / INSTALL.001 / GOLDFAST.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-12  |  83KB  |  2,779 lines
  1. {--------------------------------------------------------------------------}
  2. {                Product: TechnoJock's Turbo Toolkit                       }
  3. {                Version: GOLD                                             }
  4. {                Build:   1.01                                             }
  5. {                                                                          }
  6. {                Copyright 1986-1995  TechnoJock Software, Inc.            }
  7. {                           All Rights Reserved                            }
  8. {                          Restricted by License                           }
  9. {--------------------------------------------------------------------------}
  10.  
  11.                     {**********************************}
  12.                     {**       Unit:   GOLDFAST       **}
  13.                     {**********************************}
  14.  
  15. {++++++++++++++++++++++++++++++} unit GOLDFAST; {++++++++++++++++++++++++++++}
  16.  
  17. {$I GOLDFLAG.INC}
  18. {$IFNDEF GOLDFAST}
  19.    {$DEFINE GOLDFAST}
  20. {$ENDIF}
  21.  
  22. {++++++++++++++++++++++++++++++++} INTERFACE {+++++++++++++++++++++++++++++++}
  23.  
  24. uses DOS, CRT,
  25.      GoldReal, GoldAttr, GoldHard, GoldTint, GoldMisc, GoldStr;
  26.  
  27. const
  28.     MaxVirtualScreens = 5;    {Change this constant as necessary}
  29.     MaxButLen  = 20;          {Change this constant as necessary}
  30.     InternalScreen1 = succ(MaxVirtualScreens);
  31.     InternalScreen2 = succ(InternalScreen1);
  32.     InternalScreen3 = succ(InternalScreen2);
  33.     DefCol:byte = 255;
  34.     Plain: byte = 0;
  35.     FirstWinCol = WinBorder;   {Start value in WinTints}
  36.     LastWinCol  = WinBorderOff;
  37.     WinConfine  = 6;   {restrict screen writes to WX1..WY2}
  38. {$IFNDEF DPMI}
  39.     SegB000:word = $B000;
  40.     SegB800:word = $B800;
  41. {$ENDIF}
  42. {$IFDEF TTT5}
  43.     FCol:byte = white;
  44.     BCol:byte = black;
  45. {$ENDIF}
  46.  
  47. type
  48.    StrScreen = string[80];
  49.    StrButton = string[MaxButLen];
  50.  
  51.    VideoWord = record
  52.       Ch   : char;
  53.       Attr : byte;
  54.    end;
  55.  
  56.    gVideoTarget = (WinTarget,ScreenTarget);
  57.    gDirection = (Up,Down,Left,Right,Vert,Horiz);
  58.    WinTints   = array[FirstWinCol..LastWinCol] of byte;
  59.    ScrollType = (NoScroll,HorizScroll,VertScroll,BothScroll);
  60.  
  61.    VideoZone = record
  62.       ScreenPtr: pointer;         {pointer to display memory}
  63.       Width: byte;                {screen or window width}
  64.       Depth:byte;                 {screen or window depth}
  65.       WX1,WY1,WX2,WY2 : byte;     {local window coordinates}
  66.       WindowActive: boolean;      {writes confined within window?}
  67.       TargetType: gVideoTarget;   {window or screen}
  68.       TargetPtr: pointer;         {pointer to screen or window structure}
  69.       MoveCursor: boolean;        {is it top window or main screen}
  70.    end;
  71.  
  72.    ScreenInfoPtr = ^ScreenInfo;
  73.    ScreenInfo = record
  74.       Width: byte;           {how wide is screen}
  75.       Depth:byte;
  76.       CursorX: byte;
  77.       CursorY: byte;
  78.       ScanTop: byte;
  79.       ScanBot: byte;
  80.       Window: gByteCoords;   {active screen area}
  81.       WindowIgnore: boolean; {ignore window settings}
  82.       ScreenPtr: pointer;
  83.    end;
  84.  
  85.    StretchProc = procedure (X1,Y1,X2,Y2:byte);
  86.    WinKeyHandler = procedure;
  87.    WinCloseProc = function(Handle:integer):boolean;
  88.    WinChangeFocusProc = procedure(Handle:integer);
  89.  
  90.    CursorInfo = record
  91.       X: byte;                  {saved cursor location}
  92.       Y: byte;                  {saved       -"-      }
  93.       Top: byte;                {saved cursor size}
  94.       Bot: byte;                {saved     -"-    }
  95.    end;
  96.  
  97.    WStructurePtr = ^WStructure;
  98.    WStructure = record
  99.       {The first six fields are access by ASM code -- do not change}
  100.       SurfacePtr: pointer;          {ptr to window image}
  101.       Width: byte;
  102.       Depth: byte;
  103.       X: shortint;            {can go negative if window dragged leftward}
  104.       Y: shortint;            {can go negative if window dragged upward}
  105.       NextWinPtr: WStructurePtr;
  106.       {local (non-ASM) data follows}
  107.       WinStyle: byte;               {window appearance}
  108.       WinState: byte;               {bit flags for allowclose, allowmove, etc}
  109.       Title: StrScreen;             {window title}
  110.       Col: WinTints;                {display colors}
  111.       WinNum: byte;                 {window number}
  112.       WinX1,                        {writing/scrolling area within window}
  113.       WinY1,
  114.       WinX2,
  115.       WinY2: byte;
  116.       UserData:pointer;             {user-defined info}
  117.       {moveable windows}
  118.       Boundary: gCoords;            {max area in which window can move}
  119.       {Scrollable}
  120.       Scroll: ScrollType;           {are scroll bars supported}
  121.       {Stretch}
  122.       MinWidth: byte;               {min width of SmartWin}
  123.       MinDepth: byte;               {min depth of SmartWin}
  124.       StretchCallBack: StretchProc; {to refresh window during stretch}
  125.       {Internals}
  126.       Cursor: CursorInfo;            {state of cursor}
  127.       PreZoom: gCoords;              {size of window in Unzoomed state}
  128.       Painted: boolean;              {has window already been painted}
  129.       ProcessKeyProc: WinKeyHandler; {used in the desktop}
  130.       CloseWinProc: WinCloseProc;    {       -"-         }
  131.       ChangeFocusProc: WinChangeFocusProc; {     -"-     }
  132.    end;  {WStructure}
  133.  
  134.    FastSet = record
  135.       ECode: integer;
  136.       {scroll bar data}
  137.       UpArrowChar: char;
  138.       DownArrowChar: char;
  139.       LeftArrowChar: char;
  140.       RightArrowChar: char;
  141.       ElevatorChar: char;
  142.       BackgroundChar: char;
  143.       {progress bar data}
  144.       ProgChar1: char;
  145.       ProgChar2: char;
  146.       PerCentPad: byte;
  147.       PerCentColor: byte;
  148.       {screen}
  149.       ActiveScreen: shortint;
  150.       Screen : array[0..InternalScreen3] of ScreenInfoPtr;
  151.       {startup details}
  152.       StartMode: word;
  153.       StartTop: byte;
  154.       StartBot: byte;
  155.       StartX: byte;
  156.       StartY: byte;
  157.       {misc}
  158.       CustomCharsActive: boolean;
  159.       ExitChain: pointer;
  160.       GrowNoise: boolean;
  161.       EMsgFunc: ErrMsgFunc;
  162.    end; {FastSet}
  163.  
  164. var
  165.    FastVars: FastSet;
  166.    VideoTarget: VideoZone;
  167.  
  168.    SnowProne : boolean;      {used by Asm code}
  169.    LineWrap: boolean;        {       "        }
  170.    ShowNow: boolean;         {       "        }
  171.    ScreenLines: byte;        {       "        }
  172.    WinList: pointer;         {       "        }
  173.    BackBuffer: pointer;      {       "        }
  174.    FrontBuffer: pointer;     {       "        }
  175.    ShadowAttr: byte;         {       "        }
  176.    ShadowType: byte;         {       "        }
  177.  
  178.    WinX: byte;               {Asm scratch data}
  179.    WinY: byte;               {       "        }
  180.    WinWidth0: word;          {       "        }
  181.    WinWidth: word;           {       "        }
  182.    WinDepth0: word;          {       "        }
  183.    WinDepth: word;           {       "        }
  184.    WinOff: word;             {       "        }
  185.    SourceIncr: word;         {       "        }
  186.    TargetIncr: word;         {       "        }
  187.    Windex: word;             {       "        }
  188.    PaneWidth: word;          {       "        }
  189.    PaneDepth: word;          {       "        }
  190.    PaneOff: word;            {       "        }
  191.    PaneType: byte;           {       "        }
  192.    CRFlag: byte;             {       "        }
  193.    WriteDepth: byte;         {       "        }
  194.    BBTop: byte;              {       "        }
  195.    BBBot: byte;              {       "        }
  196.    FrontUpdated: boolean;
  197.  
  198. function  LastFastError: integer;
  199. function  OnScreen:boolean;
  200. procedure ResetStartUpMode;
  201. {window routines}
  202. procedure SetWindow(X1,Y1,X2,Y2: byte);
  203. function  GetSetWinIgnore(On:Boolean):boolean;
  204. procedure SetWinIgnore(On:Boolean);
  205. procedure ResetWindow;
  206. {cursor routines}
  207. procedure CursorFind(var X,Y,Top,Bot:byte);
  208. procedure AbsGotoXY(X,Y:byte);
  209. procedure GotoXY(X,Y:byte);
  210. procedure AbsWhereXY(var X,Y:byte);
  211. function  WhereX: byte;
  212. function  WhereY: byte;
  213. function  CharHeight: integer;
  214. procedure CursorAbsSize(T,B:byte);
  215. procedure CursorSize(T,B:byte);
  216. procedure CursorHalf;
  217. procedure CursorFull;
  218. procedure CursorOff;
  219. procedure CursorOn;
  220. {screen routines}
  221. procedure ActivateVirtualScreen(Page:word);
  222. procedure ActivateVisibleScreen;
  223. procedure ActivateBackground;
  224. procedure CreateScreen(Page,X,Y,FB:byte);
  225. procedure SaveScreen(Page:byte);
  226. procedure PartRestoreScreen(Page,X1,Y1,X2,Y2,X,Y:byte);
  227. procedure SlideRestoreScreen(Page:byte;Way:gDirection);
  228. procedure PartSlideRestoreScreen(Page:byte;Way:gDirection;X1,Y1,X2,Y2:byte);
  229. procedure RestoreScreen(Page:byte);
  230. procedure DisposeScreen(Page:byte);
  231. procedure CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  232. procedure MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  233. procedure Scroll(Way:gDirection;X1,Y1,X2,Y2:byte);
  234. {screen writing}
  235. procedure FillScreen(X1,Y1,X2,Y2:byte; FB:byte; C:char);
  236. procedure Clear(FB:byte; C:Char);
  237. procedure PartClear(X1,Y1,X2,Y2:byte; FB:byte; C:char);
  238. procedure WritePlain(X,Y:byte; St:string);
  239. procedure WriteAT(X,Y,FB:byte; St:string);
  240. procedure WriteCol(Col,Row:byte; St:string);
  241. procedure WriteCap(X,Y,FBCap,FB:byte;Str:string);
  242. procedure WriteHi(X,Y,HiFB,FB:byte;Str:string);
  243. procedure WriteHiX2(X1,X2,Y,HiFB,FB:byte;Str:string);
  244. procedure WriteHiCenter(Y,HiFB,FB:byte;Str:string);
  245. procedure WriteClick(X,Y,FB:byte;Str:string);
  246. procedure WriteCenter(Y,FB:byte;Str:string);
  247. procedure WriteMiddle(X,FB:byte;Str:string);
  248. procedure WriteBetween(X1,X2,Y,FB:byte;Str:string);
  249. procedure WriteRight(X,Y,FB:byte;Str:string);
  250. procedure WriteVert(X,Y,FB:byte;Str:string);
  251. procedure WriteProgressLong(X1,X2,Y:byte;Part,Total:longint;ShowPerCent:boolean);
  252. procedure WriteProgressReal(X1,X2,Y:byte;Part,Total:extended;ShowPerCent:boolean);
  253. procedure Attrib(X1,Y1,X2,Y2,FB:byte);
  254. procedure ClearText(X1,Y1,X2,Y2,FB:byte);
  255. procedure ClearLine(Y,FB:integer);
  256. {screen reading}
  257. procedure ReadWord(X,Y:byte;var Attr:byte; var Ch : char);
  258. function  ReadChar(X,Y:byte):char;
  259. function  ReadAttr(X,Y:byte):byte;
  260. function  ReadStr(X1,X2,Y:byte):string;
  261. {box and line drawing}
  262. procedure Box(X1,Y1,X2,Y2,FB,style:byte);
  263. procedure FBox(X1,Y1,X2,Y2,FB,style:byte);
  264. procedure GrowFBox(X1,Y1,X2,Y2,FB,style:byte);
  265. procedure Box3D(X1,Y1,X2,Y2:byte;TLFB,BRFB,Style:byte);
  266. procedure HorizLine(X1,X2,Y,FB,Style : byte);
  267. procedure VertLine(X,Y1,Y2,FB,Style:byte);
  268. procedure SmartVertLine(X,Y1,Y2,FB,Style:byte);
  269. procedure SmartHorizLine(X1,X2,Y,FB,Style:byte);
  270. {shadow routines}
  271. procedure DrawShadow(X1,Y1,X2,Y2:integer);
  272. procedure OuterXY(var X1,Y1,X2,Y2: integer);
  273. {display routines}
  274. procedure SetCondensed;
  275. procedure Set25;
  276. procedure SetBlinking(On:boolean);
  277. {scroll bars}
  278. procedure SetScrollChars(U,D,L,R,E,B:char);
  279. procedure SetScrollDefaults;
  280. function  GetHScrollBarElevator(X1,X2:byte;Current,Max:longint) : byte;
  281. function  GetVScrollBarElevator(Y1,Y2:byte;Current,Max:longint) : byte;
  282. procedure WriteHScrollBar(X1,X2,Y,FB: byte; Current,Max: longint);
  283. procedure WriteVScrollBar(X,Y1,Y2,FB: byte; Current,Max: longint);
  284. {custom ASCII characters}
  285. {$IFNDEF NOVGACHARS}
  286. function  CustomCapable: boolean;
  287. procedure UseCustomChars;
  288. procedure UseCustomFunctionKeys;
  289. procedure RemoveCustomChars;
  290. {$ENDIF} {NOVGACHARS}
  291. {internal procedures used by other toolkit units}
  292. procedure CursorPos(X,Y: integer);
  293. procedure WinWrite(var WinImage; Width,X1,Y2,X2,Y2,X3,Y3,Attr:byte; St:string;WWIgnore:byte);
  294. procedure WinPlain(var WinImage; Width,X1,Y2,X2,Y2,X3,Y3,Attr:byte; St:string;WWIgnore:byte);
  295. procedure WinAttr(var WinImage; Width,X1,Y2,X2,Y2,X3,Y3,X4,Y4,Attr:byte;WWIgnore:byte);
  296. procedure WinDrawAll;
  297. procedure WinDrawTop;
  298. procedure FillVideo(var Buffer; Count:word; Info:VideoWord);
  299. procedure MoveToScreen(SourceY1,SourceX1,SourceY2,SourceX2,SourceWidth:byte;var SourcePtr;
  300.                          TargetX,TargetY,TargetWidth:byte;var TargetPtr);
  301. procedure MoveFromScreen(X1,Y1,X2,Y2,SourceWidth:byte; var SourcePtr, TargetPtr);
  302. function  Different(var Source1,Source2;Size:word):boolean;
  303. procedure WinRedraw(MakeVisible:boolean);
  304. procedure DrawButton(X1,X2,Y,HiFB,FB:byte; Str:string);
  305. procedure DrawButtonDown(X1,X2,Y,HiFB,FB:byte; Str:string);
  306. procedure PartSave (X1,Y1,X2,Y2:byte; VAR Dest);
  307. procedure PartRestore (X1,Y1,X2,Y2:byte; VAR Source);
  308. {$IFDEF TTT5}
  309. procedure FastWrite(Col,Row,Attr:byte; St:StrScreen);
  310. procedure FWrite(St:StrScreen);
  311. procedure FWriteLN(St:StrScreen);
  312. function  EGAVGASystem: boolean;
  313. procedure SetCondensedLines;
  314. procedure Set25Lines;
  315. procedure Activate_Visible_Screen;
  316. procedure Activate_Virtual_Screen(Page:byte);
  317. procedure Reset_StartUp_Mode;
  318. function  GetScreenChar(X,Y:byte):char;
  319. function  GetScreenAttr(X,Y:byte):byte;
  320. procedure GetScreenStr(X1,X2,Y:byte;var  St:StrScreen);
  321. procedure PlainWrite(X,Y:byte; St:string);
  322. procedure FBAttrib(X1,Y1,X2,Y2,F,B:byte);
  323. procedure FBClickwrite(Col,Row,F,B:byte; St:StrScreen);
  324. procedure FBBox(X1,Y1,X2,Y2,F,B,boxtype:integer);
  325. procedure FBFBox(X1,Y1,X2,Y2,F,B,boxtype:integer);
  326. procedure FBGrowFBox(X1,Y1,X2,Y2,F,B,boxtype:integer);
  327. procedure FBHorizLine(X1,X2,Y,F,B,lineType:byte);
  328. procedure FBVertLine(X,Y1,Y2,F,B,lineType:byte);
  329. procedure FBClearText(x1,y1,x2,y2,F,B:integer);
  330. procedure FBClearLine(Y,F,B:integer);
  331. procedure FBWriteAT(X,Y,F,B:integer; St:StrScreen);
  332. procedure FBWriteBetween(X1,X2,Y,F,B:byte; St:StrScreen);
  333. procedure FBWriteCenter(LineNO,F,B:integer; St:StrScreen);
  334. procedure FBWriteVert(X,Y,F,B:integer; St:StrScreen);
  335. procedure FBFillScreen(X1,Y1,X2,Y2:byte; F,B:byte; C:char);
  336.  
  337. {$ENDIF}
  338.  
  339. {+++++++++++++++++++++++++++++} IMPLEMENTATION {+++++++++++++++++++++++++++++}
  340. uses GoldKey;
  341.  
  342. const
  343.   MaxVScreens = InternalScreen3;  {3 screens are used internally}
  344.   ShadWidth = 2;
  345.   ShadDepth = 1;
  346.  
  347. {$IFNDEF NOVGACHARS}
  348. (*
  349.  Notes:  The following contains the code for using custom ASCII
  350.          characters on VGA systems.
  351.  
  352.          The replacment characters come in two categories: characters
  353.          which need to touch the adjacent character, known as "wide"
  354.          characters, and regular characters.
  355.  
  356.          The wide fonts must be located in the region 192 to 223 of
  357.          the 256 ASCII characters. DOS assumes that all characters
  358.          outside of this region will not be joined.
  359.  
  360.          To avoid using characters required in normal text, Gold
  361.          sacrifices double line-drawing characters and replaces
  362.          them with custom characters. In otherwords, you can't
  363.          have the custom fonts and double line boxes.
  364.  
  365.          The following custom characters are provided:
  366.  
  367.          Line Drawing:
  368.  
  369.              Single line box drawing characters where the line is
  370.              on the outside of the box
  371.              Thin line characters for chisel/indentation effects
  372.  
  373.          Single Character Icons
  374.               Check Mark (Tick for you Brits}
  375.               Function keys F1 to F12
  376.  
  377.          Double Character Icons
  378.               Close Window
  379.               Check box - empty
  380.               Check box - selected
  381.               Radio button - empty
  382.               Radio button - selected
  383.               Maximize Window
  384.               Normalize Windows
  385. *)
  386.  
  387. const
  388.    CharSize  = 16;
  389.    WideCharCount = 19;
  390.    WideCharStart = 198;   {to 216}
  391.    Wide2CharCount = 2;
  392.    Wide2CharStart = 221;
  393.    RegularCharCount = 9;
  394.    RegularCharStart = 181;
  395.    Regular2CharCount = 12;
  396.    Regular2CharStart = 224;
  397.  
  398. type
  399.    WideCharBuffer = array[1..WideCharCount*CharSize] of byte;
  400.    Wide2CharBuffer = array[1..Wide2CharCount*CharSize] of byte;
  401.    RegularCharBuffer = array[1..RegularCharCount*CharSize] of byte;
  402.    Regular2CharBuffer = array[1..Regular2CharCount*CharSize] of byte;
  403.  
  404. {$IFNDEF DPMI}
  405. const
  406.    WideChars: WideCharBuffer =
  407.       (
  408. {$IFDEF THINLINES}
  409.        $C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$FF, {198 - bottom left corner}
  410.        $01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$FF, {199 - bottom right corner}
  411.        $FF,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01, {200 - top right corner}
  412.        $FF,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0, {201 - top left corner}
  413.        $FF,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, {202 - top}
  414.        $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$FF, {203 - bottom}
  415.        $01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01, {204 - rightvert}
  416. {$ELSE}
  417.        $E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$FF,$FF, {198 - bottom left corner}
  418.        $03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$FF,$FF, {199 - bottom right corner}
  419.        $FF,$FF,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03, {200 - top right corner}
  420.        $FF,$FF,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0, {201 - top left corner}
  421.        $FF,$FF,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, {202 - top}
  422.        $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$FF,$FF, {203 - bottom}
  423.        $03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03, {204 - rightvert}
  424. {$ENDIF}
  425.        $FF,$80,$80,$80,$81,$83,$87,$80,$80,$87,$83,$81,$80,$80,$80,$FF, {205 - normalize left}
  426.        $FF,$80,$80,$80,$80,$80,$80,$9F,$9F,$80,$80,$80,$80,$80,$80,$FF, {206 - winclose left}
  427.        $FF,$01,$01,$01,$01,$01,$01,$F9,$F9,$01,$01,$01,$01,$01,$01,$FF, {207 - winclose right}
  428.  
  429.        $00,$07,$04,$04,$04,$04,$04,$04,$04,$04,$04,$04,$04,$07,$01,$00, {208 - check box left}
  430.        $00,$FF,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$FF,$FF,$00, {209 - check box middle unchecked}
  431.        $00,$FF,$00,$06,$06,$0C,$0C,$18,$98,$F0,$70,$20,$00,$FF,$FF,$00, {210 - check box middle checked}
  432.        $00,$00,$00,$01,$02,$02,$04,$04,$04,$04,$02,$02,$01,$00,$00,$00, {211 - radio button left}
  433.  
  434.        $00,$00,$FE,$01,$00,$00,$00,$00,$00,$00,$00,$00,$01,$FE,$00,$00, {212 - radio button middle unselected}
  435.        $00,$00,$FE,$01,$00,$7C,$FE,$FE,$FE,$FE,$7C,$00,$01,$FE,$00,$00, {213 - radio button middle selected}
  436.        $00,$00,$00,$03,$0C,$10,$20,$20,$20,$20,$10,$0C,$03,$00,$00,$00, {214 - free}
  437.        $00,$00,$00,$03,$0C,$11,$23,$27,$27,$23,$11,$0C,$03,$00,$00,$00, {215 - free}
  438.        $FF,$01,$01,$01,$01,$81,$C1,$01,$01,$C1,$81,$01,$01,$01,$01,$FF  {216 - normlize right}
  439.     );
  440.  
  441.    Wide2Chars: Wide2CharBuffer =
  442.       (
  443.        $FF,$80,$80,$80,$80,$80,$80,$81,$83,$87,$80,$80,$80,$80,$80,$FF, {221 - maximize left}
  444.        $FF,$01,$01,$01,$01,$01,$01,$01,$81,$C1,$01,$01,$01,$01,$01,$FF  {222 - maximize right}
  445.       );
  446.    RegularChars: RegularCharBuffer =
  447.       (
  448.       $80,$C0,$E0,$F0,$F8,$FC,$FE,$F8,$F8,$BC,$1C,$0E,$0C,$00,$00,$00, {181 - mouse cursor arrow}
  449.       $03,$03,$03,$06,$06,$06,$0C,$0C,$CC,$CC,$6C,$78,$18,$00,$00,$00, {182 - check mark}
  450.       $00,$E0,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$30,$F0,$F0,$00, {183 - check box right}
  451.       $00,$00,$00,$00,$80,$80,$40,$40,$40,$40,$80,$80,$00,$00,$00,$00, {184 - radio button right}
  452.       $01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01, {185 - thin vertical line}
  453.       $00,$00,$00,$80,$60,$10,$08,$08,$08,$08,$10,$60,$80,$00,$00,$00, {186 - free}
  454.       $00,$00,$00,$80,$60,$10,$88,$C8,$C8,$88,$10,$60,$80,$00,$00,$00, {187 - free}
  455.       $FF,$01,$01,$01,$01,$01,$01,$81,$C1,$E1,$01,$01,$01,$01,$01,$FF, {188 - normalize right}
  456. {$IFDEF THINLINES}
  457.       $C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0  {189 - left vert}
  458. {$ELSE}
  459.       $E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0,$E0  {189 - left vert}
  460. {$ENDIF}
  461.       );
  462.  
  463.    Regular2Chars: Regular2CharBuffer =
  464.       (
  465.       $00,$7C,$40,$40,$70,$40,$40,$40,$04,$0C,$04,$04,$04,$04,$0E,$00, {224 - F1}
  466.       $00,$7C,$40,$40,$70,$40,$40,$40,$06,$09,$01,$02,$04,$08,$0F,$00, {225 - F2}
  467.       $00,$7C,$40,$40,$70,$40,$40,$40,$0F,$01,$01,$02,$01,$09,$06,$00, {226 - F3}
  468.       $00,$7C,$40,$40,$70,$40,$40,$40,$08,$08,$0A,$0A,$0F,$02,$02,$00, {227 - F4}
  469.       $00,$7C,$40,$40,$70,$40,$40,$40,$0E,$10,$10,$1C,$02,$02,$1C,$00, {228 - F5}
  470.       $00,$7C,$40,$40,$70,$40,$40,$40,$0C,$10,$10,$1C,$12,$12,$0C,$00, {229 - F6}
  471.       $00,$7C,$40,$40,$70,$40,$40,$40,$1E,$02,$02,$0C,$08,$08,$08,$00, {230 - F7}
  472.       $00,$7C,$40,$40,$70,$40,$40,$40,$0C,$12,$12,$0C,$12,$12,$0C,$00, {231 - F8}
  473.       $00,$7C,$40,$40,$70,$40,$40,$40,$0C,$12,$12,$0E,$02,$02,$0C,$00, {232 - F9}
  474.       $00,$7C,$40,$40,$70,$40,$40,$40,$26,$69,$29,$29,$29,$29,$76,$00, {233 - F10}
  475.       $00,$7C,$40,$40,$70,$40,$40,$40,$22,$66,$22,$22,$22,$22,$77,$00, {234 - F11}
  476.       $00,$7C,$40,$40,$70,$40,$40,$40,$26,$69,$21,$22,$24,$28,$7F,$00  {235 - F12}
  477.       );
  478. {$ENDIF}
  479.  
  480. (*
  481. var
  482.    TwiddleDummy: array[1..64] of byte; {used by TWIDDLE.ASM}
  483.    OriginalChars: array[1..4] of byte; {characters that are replaced with Mouse image}
  484.  
  485. {$IFOPT F-}
  486.    {$DEFINE FOFF}
  487.    {$F+}
  488. {$ENDIF}
  489.  
  490. {$L TWIDDLE}
  491. procedure Twiddle(Y,X:byte; var Curs); external;
  492.  
  493. {$IFDEF FOFF}
  494.    {$F-}
  495.    {$UNDEF FOFF}
  496. {$ENDIF}
  497. *)
  498.  
  499. procedure SetVGAChars(var Fonts; Start,Count:word);
  500. {INTERNAL}
  501. var Regs: registers;
  502. begin
  503.    with Regs do
  504.    begin
  505.       Ah := $11;
  506.       Al := $00;
  507.       bl := 0;
  508.       ES := seg(Fonts);
  509.       BP := ofs(Fonts);
  510.       CX := Count;
  511.       DX := Start;
  512.       Bh := CharSize;
  513.    end;
  514.    intr($10,Regs);
  515. end; { SetVGAChars }
  516.  
  517. function CustomCapable: boolean;
  518. {}
  519. begin
  520.    CustomCapable := HardVars.DisplayType in [VGAMono,VGACol];
  521. end; { CustomCapable }
  522.  
  523. procedure UseCustomChars;
  524. {Remaps the upper ASCII characters to radio buttons, thin lines, etc}
  525. begin
  526.    {$IFNDEF DPMI}
  527.    if CustomCapable then
  528.    begin
  529.       SetVGAChars(WideChars,WideCharStart,WideCharCount);
  530.       SetVGAChars(RegularChars,RegularCharStart,RegularCharCount);
  531.       FastVars.CustomCharsActive := true;
  532.    end;
  533.    {$ENDIF}
  534. end; { UseCustomChars }
  535.  
  536. procedure UseCustomFunctionKeys;
  537. {Remaps some upper ASCII characters to show function keys, etc.}
  538. begin
  539.    {$IFNDEF DPMI}
  540.    SetVGAChars(Regular2Chars,Regular2CharStart,Regular2CharCount);
  541.    {$ENDIF}
  542. end; { UseCustomFunctionKeys }
  543.  
  544. procedure RemoveCustomChars;
  545. {}
  546. var Regs: registers;
  547. begin
  548.    if FastVars.CustomCharsActive then
  549.    begin
  550.       with Regs do
  551.       begin
  552.          Ah := $0;
  553.          Al := $3;
  554.       end;
  555.       intr($10,Regs);
  556.       FastVars.CustomCharsActive := false;
  557.    end;
  558. end; { RemoveCustomChars }
  559.  
  560.                            {*******************}
  561.                            {**  Box Drawing  **}
  562.                            {*******************}
  563.  
  564. procedure Box3D(X1,Y1,X2,Y2:byte;TLFB,BRFB,Style:byte);
  565. {Draws a chiselled 3D box - ensure that background colors are the same}
  566. var CharStr: string[6];
  567.     I: integer;
  568. begin
  569.    ClearText(X1,Y1,X2,Y2,TLFB);
  570.    if (X2-X1 > 4) and (Y2-Y1 > 1) then
  571.    begin
  572.       if Style <> 2 then
  573.          CharStr := '┌─┐│┘└'
  574.       else
  575.          CharStr := '╔═╗║╝╚';
  576.       WritePlain(succ(X1),Y1,CharStr[1]);
  577.       WritePlain(X1+2,Y1,replicate(X2-X1-3,CharStr[2]));
  578.       WritePlain(succ(X1),Y2,CharStr[6]);
  579.       WriteAT(pred(X2),Y1,BRFB,CharStr[3]);
  580.       for I := succ(Y1) to pred(Y2) do
  581.       begin
  582.          WritePlain(succ(X1),I,CharStr[4]);
  583.          WriteAT(pred(X2),I,BRFB,CharStr[4]);
  584.       end;
  585.       WriteAT(pred(X2),Y2,BRFB,CharStr[5]);
  586.       WriteAT(X1+2,Y2,BRFB,replicate(X2-X1-3,CharStr[2]));
  587.    end;
  588. end; { Box3D }
  589.  
  590. {            Styles:
  591.                        1   -   Single Line Border - Standard
  592.                        2   -   Double Line Border
  593.                        3   -   Title Bar (caption)
  594.                        4   -   Edge Border w/o title bar
  595.                        5   -   Menu Style a la Professional Write
  596.                        6   -   Edge Border with title bar
  597.                        7   -   Chisel Raised
  598.                        8   -   Chisel Sunken
  599.                        9   -   Notepad
  600. }
  601.  
  602. procedure Box(X1,Y1,X2,Y2,FB,style:byte);
  603. {draws box and leaves internal area as is}
  604. const
  605.    Style0:string[8] = '        ';
  606.    Style1:string[8] = '│┌─┐│└─┘';
  607.    Style2:string[8] = '║╔═╗║╚═╝';
  608.    Style4:string[8] = chr(189)+chr(201)+chr(202)+chr(200)+chr(204)+chr(198)+chr(203)+chr(199);
  609. var
  610.    Line,
  611.    FLine:string;
  612.    Str: string[8];
  613.    I: integer;
  614.  
  615.    procedure DrawTheRest;
  616.    {}
  617.    var I: integer;
  618.    begin
  619.       for I := succ(Y1) to pred(Y2) do
  620.       begin
  621.          WriteAt(X1,I,FB,Str[1]);
  622.          WriteAt(X2,I,FB,Str[5]);
  623.       end;
  624.       WriteAt(X1,Y2,FB,Str[6]);
  625.       WriteAt(X1+1,Y2,FB,replicate(pred(X2-X1),Str[7]));
  626.       WriteAt(X2,Y2,FB,Str[8]);
  627.    end; { DrawTheRest }
  628.  
  629. begin
  630.    if (not FastVars.CustomCharsActive and (Style = 4))
  631.    or (FastVars.CustomCharsActive and (Style = 2)) then
  632.       Style := 1;
  633.    case Style of
  634.       0,1,
  635.       2,4:begin
  636.              case Style of
  637.                 0: Str := Style0;
  638.                 1: Str := Style1;
  639.                 2: Str := Style2;
  640.                 else Str := Style4;
  641.              end; {case}
  642.              {draw first line of the box}
  643.              WriteAt(X1,Y1,FB,Str[2]);
  644.              WriteAt(X1+1,Y1,FB,replicate(pred(X2-X1),Str[3]));
  645.              WriteAt(X2,Y1,FB,Str[4]);
  646.              DrawTheRest;
  647.           end;
  648.         3:begin
  649.              WriteAT(X1,Y1,FB,replicate(succ(X2-X1),' '));
  650.           end;
  651.         5:begin
  652.              ClearText(X1,Y1,X2,Y2,FB);
  653.              WriteAT(X1,Y1,FB,replicate(X2-pred(X1),char(223)));
  654.              WriteAT(X1,Y1+2,FB,replicate(X2-pred(X1),'─'));
  655.           end;
  656.         6:begin
  657.              if FastVars.CustomCharsActive then
  658.                 Str := Style4
  659.              else
  660.                 Str := Style1;
  661.              WriteAT(X1,Y1,FB,replicate(succ(X2-X1),' '));
  662.              DrawTheRest;
  663.           end;
  664.         7:begin
  665.              Box3D(X1,Y1,X2,Y2,Cattr(15,Battr(FB)),Cattr(0,Battr(FB)),1);
  666.           end;
  667.         8:begin
  668.              Box3D(X1,Y1,X2,Y2,Cattr(0,Battr(FB)),Cattr(15,Battr(FB)),1);
  669.           end;
  670.         9:begin
  671.              ClearText(X1,Y1,X2,Y2,FB);
  672.              for I := X1 to X2 do
  673.              if not odd(I) then
  674.                 WriteAt(I,Y1+3,Cattr(black,bAttr(FB)),'─')
  675.              else
  676.                 WriteAt(I,Y1+3,15,'('); { white,black }
  677.           end;
  678.           else
  679.           begin
  680.              Str := replicate(8,chr(Style));
  681.              WriteAt(X1,Y1,FB,replicate(succ(X2-X1),Str[1]));
  682.              WriteAt(X1,Y2,FB,replicate(succ(X2-X1),Str[1]));
  683.              for I := succ(Y1) to pred(Y2) do
  684.              begin
  685.                 WriteAt(X1,I,FB,Str[1]);
  686.                 WriteAt(X2,I,FB,Str[5]);
  687.              end;
  688.           end;
  689.    end; {case}
  690. end; { Box }
  691.  
  692. procedure FBox(X1,Y1,X2,Y2,FB,style:byte);
  693. {draws box and erases internal area}
  694. begin
  695.    Box(X1,Y1,X2,Y2,FB,Style);
  696.    case style of
  697.       3: ClearText(X1,succ(Y1),X2,Y2,FB);
  698.       5: begin
  699.             ClearText(X1,succ(Y1),X2,succ(Y1),FB);
  700.             ClearText(X1,Y1+3,X2,Y2,FB);
  701.          end;
  702.       7,8: ClearText(X1+2,succ(Y1),X2-2,succ(Y1),FB);
  703.       9:;
  704.       else ClearText(succ(X1),succ(Y1),pred(X2),pred(Y2),FB);
  705.    end; {case}
  706. end; { FBox }
  707.  
  708. procedure GrowFBox(X1,Y1,X2,Y2,FB,style:byte);
  709. {draws box and erases internal area}
  710. const
  711.   Stages = 4;
  712.   StartX = 3;
  713.   StartY = 3;
  714.   ClockTicksPerStage = 1;
  715. var
  716.   Counter,TX1,TY1,TX2,TY2,XDelta,YDelta: integer;
  717.   LastTime, NewTime: longint;
  718. begin
  719.    if (X2-X1) < StartX then
  720.    begin
  721.       TX2 := X2;
  722.       TX1 := X1;
  723.    end else
  724.    begin
  725.       XDelta := (X2-X1) div (Stages * 2);
  726.       if XDelta < 1 then
  727.          XDelta := 1;
  728.       TX2 := (X2 - X1) div 2 + X1 + 2;
  729.       TX1 := TX2 - 3;                 {needs a box 3 by 3 minimum}
  730.    end;
  731.    if (Y2-Y1) < StartY then
  732.    begin
  733.       TY2 := Y2;
  734.       TY1 := Y1;
  735.    end else
  736.    begin
  737.       YDelta := (Y2-Y1) div (Stages * 2);
  738.       if YDelta < 2 then
  739.          YDelta := 2;
  740.       TY2 := (Y2 - Y1) div 2 + Y1 + 2;
  741.       TY1 := TY2 - 3;
  742.    end;
  743.    LastTime := KeyGetTime;
  744.    NewTime := LastTime;
  745.    Counter := 0;
  746.    repeat
  747.       inc(Counter);
  748.       FBox(TX1,TY1,TX2,TY2,FB,Style);
  749.       if TX1 >= X1 then
  750.          dec(TX1,XDelta);
  751.       if TX1 < X1 then
  752.          TX1 := X1;
  753.       if TY1 >= Y1 then
  754.          dec(TY1,YDelta);
  755.       if TY1 < Y1 then
  756.          TY1 := Y1;
  757.       if TX2 <= X2 then
  758.          inc(TX2,XDelta);
  759.       if TX2 > X2 then
  760.          TX2 := X2;
  761.       if TY2 <= Y2 then
  762.          inc(TY2,YDelta);
  763.       if TY2 > Y2 then
  764.          TY2 := Y2;
  765.       if FastVars.GrowNoise then
  766.          sound(500+Counter*350);delay(5+Counter*5);nosound;
  767.       while NewTime < LastTime + ClockTicksPerStage do
  768.           NewTime := KeyGetTime;
  769.       LastTime := NewTime;
  770.    until (TX1 = X1) and (TY1 = Y1) and (TX2 = X2) and (TY2 = Y2);
  771.    FBox(X1,Y1,X2,Y2,FB,Style);
  772. end; { GrowFBox }
  773.  
  774. procedure HorizLine(X1,X2,Y,FB,Style : byte);
  775. var I: integer;
  776.     LineChar: char;
  777. begin
  778.    case Style of
  779.       0  : LineChar := ' ';
  780.       2,4: LineChar := '═';
  781.       1,3: LineChar := '─';
  782.       else LineChar := Chr(Style);
  783.    end; {case}
  784.    WriteAt(X1,Y,FB,replicate(X2-X1+1,LineChar))
  785. end;   { HorizLine }
  786.  
  787. procedure VertLine(X,Y1,Y2,FB,Style:byte);
  788. {}
  789. var I: integer;
  790.     LineChar: char;
  791. begin
  792.    case Style of
  793.       0  : LineChar := ' ';
  794.       2,4: LineChar := '║';
  795.       1,3: LineChar := '│';
  796.       else LineChar := Chr(Style);
  797.    end; {case}
  798.    for I := Y1 to Y2 do
  799.       WriteAt(X,I,FB,LineChar)
  800. end; { VertLine }
  801.  
  802. procedure SmartVertLine(X,Y1,Y2,FB,Style:byte);
  803. {draws box character and adjust any lines it overlays}
  804. var I: integer;
  805.     LineStr: string[19];
  806.     TestCh, Ch: char;
  807.     StringOffset: byte;
  808.  
  809.     function AdjacentChar(X,Y:byte): char;
  810.     {}
  811.     begin
  812.        if (X < 1) or (X > FastVars.Screen[FastVars.ActiveScreen]^.Width) then
  813.           AdjacentChar := ' '
  814.        else
  815.           AdjacentChar := ReadChar(X,Y);
  816.     end; { AdjacentChar }
  817.  
  818.     function LineCh(X,Y:byte): char;
  819.     {}
  820.     const
  821.        LeftSingle: string[13] = '─┬┐┼┤┴┘╥╖╫╢╨╜';
  822.        LeftDouble: string[13] = '═╦╗╬╣╩╝╤╕╪╡╧╛';
  823.        RightSingle:string[13] = '┌─┬├┼└┴╓╥╟╫╙╨';
  824.        RightDouble:string[13] = '╔═╦╠╬╚╩╒╤╞╪╘╧';
  825.     var LineStyle: char;
  826.     begin
  827.        LineStyle := AdjacentChar(pred(X),Y);
  828.        if pos(LineStyle,RightSingle) > 0 then
  829.           LineStyle := '─'
  830.        else if pos(LineStyle,RightDouble) > 0 then
  831.           LineStyle := '═'
  832.        else
  833.           LineStyle := ' ';
  834.        case LineStyle of
  835.           '─': if pos(AdjacentChar(succ(X),Y),leftSingle) > 0 then
  836.                   Ch := LineStr[2+StringOffset]
  837.                else
  838.                   Ch := LineStr[3+StringOffset];
  839.           '═': if pos(AdjacentChar(succ(X),Y),LeftDouble) > 0 then
  840.                   Ch := LineStr[4+StringOffset]
  841.                else
  842.                   Ch := LineStr[5+StringOffset];
  843.           else  TestCh := AdjacentChar(succ(X),Y);
  844.                 If pos(TestCh,LeftSingle) > 0 then
  845.                    Ch := LineStr[6+StringOffset]
  846.                 else if pos(TestCh,LeftDouble) > 0  then
  847.                    Ch := LineStr[7+StringOffset]
  848.                 else
  849.                    Ch := LineStr[1];
  850.        end; {case}
  851.        LineCh := Ch;
  852.     end; { LineCh }
  853.  
  854. begin
  855.    if Style in [2,4] then
  856.       LineStr := '║╥╖╦╗╓╔╫╢╬╣╟╠╨╜╩╝╙╚'
  857.    else
  858.       LineStr := '│┬┐╤╕┌╒┼┤╪╡├╞┴┘╧╛└╘';
  859.    {draw first character}
  860.    StringOffSet := 0;
  861.    WriteAt(X,Y1,FB,LineCh(X,Y1));
  862.    StringOffSet := 6;
  863.    for I := succ(Y1) to pred(Y2) do
  864.       WriteAt(X,I,FB,LineCh(X,I));
  865.    StringOffSet := 12;
  866.    WriteAt(X,Y2,FB,LineCh(X,Y2));
  867. end; { SmartVertLine }
  868.  
  869. procedure SmartHorizLine(X1,X2,Y,FB,Style:byte);
  870. {draws box character and adjust any lines it overlays}
  871. var I: integer;
  872.     LineStr: string[19];
  873.     TestCh, Ch: char;
  874.     StringOffset: byte;
  875.  
  876.     function AdjacentChar(X,Y:byte): char;
  877.     {}
  878.     begin
  879.        if (Y < 1) or (Y > FastVars.Screen[FastVars.ActiveScreen]^.Depth) then
  880.           AdjacentChar := ' '
  881.        else
  882.           AdjacentChar := ReadChar(X,Y);
  883.     end; { AdjacentChar }
  884.  
  885.     function LineCh(X,Y:byte): char;
  886.     {}
  887.     const
  888.         DownSingle: string[13] = '┌┬┐│├┼┤╒╤╕╞╪╡';
  889.  
  890.         DownDouble: string[13] = '╔╦╗║╠╬╣╓╥╖╟╫╢';
  891.  
  892.         UpSingle:   string[13] = '│├┼┤└┴┘╞╪╡╘╧╛';
  893.  
  894.         UpDouble:   string[13] = '║╠╬╣╚╩╝╟╫╢╙╨║';
  895.     var
  896.       LineStyle: char;
  897.     begin
  898.        LineStyle := AdjacentChar(X,pred(Y));
  899.        If pos(LineStyle,DownSingle) > 0 then
  900.           LineStyle := '│'
  901.        else if pos(LineStyle,DownDouble) > 0 then
  902.           LineStyle := '║'
  903.        else
  904.           LineStyle := ' ';
  905.        case LineStyle of
  906.           '│': if pos(AdjacentChar(X,succ(Y)),UpSingle) > 0 then
  907.                   Ch := LineStr[2+StringOffset]
  908.                else
  909.                   Ch := LineStr[3+StringOffset];
  910.           '║': if pos(AdjacentChar(X,succ(Y)),UpDouble) > 0 then
  911.                   Ch := LineStr[4+StringOffset]
  912.                else
  913.                   Ch := LineStr[5+StringOffset];
  914.           else  TestCh := AdjacentChar(X,succ(Y));
  915.                 If pos(TestCh,UpSingle) > 0 then
  916.                    Ch := LineStr[6+StringOffset]
  917.                 else if pos(TestCh,UpDouble) > 0 then
  918.                    Ch := LineStr[7+StringOffset]
  919.                 else
  920.                    Ch := LineStr[1];
  921.        end; {case}
  922.        LineCh := Ch;
  923.     end; { LineCh }
  924.  
  925. begin
  926.    if Style in [2,4] then
  927.       LineStr := '═╞╘╠╚╒╔╪╧╬╩╤╦╡╛╣╝╕╗ '
  928.    else
  929.       LineStr := '─├└╟╙┌╓┼┴╫╨┬╥┤┘╢╜┐╖';
  930.    {draw first character}
  931.    StringOffSet := 0;
  932.    WriteAt(X1,Y,FB,LineCh(X1,Y));
  933.    StringOffSet := 6;
  934.    for I := succ(X1) to pred(X2) do
  935.       WriteAt(I,Y,FB,LineCh(I,Y));
  936.    StringOffSet := 12;
  937.    WriteAt(X2,Y,FB,LineCh(X2,Y));
  938. end; { SmartHorizLine }
  939.  
  940.                          {***********************}
  941.                          {**  Shadow Routines  **}
  942.                          {***********************}
  943.  
  944. procedure DrawShadow(X1,Y1,X2,Y2:integer);
  945. {}
  946. begin
  947.    Attrib(succ(X2),succ(Y1),X2+ShadWidth,Y2+ShadDepth,ShadowAttr);
  948.    Attrib(X1+ShadWidth,succ(Y2),X2,Y2+ShadDepth,ShadowAttr);
  949. end; { DrawShadow }
  950.  
  951. procedure OuterXY(var X1,Y1,X2,Y2: integer);
  952. {Calculates the outer dimension when a window of dimenesion X1,Y1,X2,Y2
  953.  is drawn with a shadow - the shadow is assumed down and to the right}
  954. begin
  955.    inc(X2,ShadWidth);
  956.    if X2 >= HardVars.Width then
  957.       X2 := HardVars.Width;
  958.    inc(Y2,ShadDepth);
  959.    if Y2 >= HardVars.Depth then
  960.       Y2 := HardVars.Depth;
  961. end; { OuterXY }
  962.  
  963.                          {************************}
  964.                          {**  Display Routines  **}
  965.                          {************************}
  966.  
  967. procedure SetCondensed;
  968. {sets to maximum number of display lines supported by the display system}
  969. begin
  970.    if OnScreen and (HardVars.DisplayType in [EGAMono,EGACol,VGAMono,VGACol]) then
  971.    begin
  972.       TextMode(Lo(LastMode)+Font8x8);
  973.       HardVars.Depth := succ(Hi(WindMax));
  974.       if FastVars.Screen[0]^.Window.Y2 = 25 then
  975.          FastVars.Screen[0]^.Window.Y2 := HardVars.Depth;
  976.       FastVars.Screen[0]^.Depth := HardVars.Depth;
  977.       ActivateVirtualScreen(0);
  978.    end;
  979. end; { SetCondensed }
  980.  
  981. procedure Set25;
  982. {resets display back to 25 lines}
  983. begin
  984.    if OnScreen and (HardVars.Depth <> 25) then
  985.    begin
  986.       TextMode(Lo(LastMode));
  987.       HardVars.Depth := succ(Hi(WindMax));
  988.       FastVars.Screen[0]^.Depth := HardVars.Depth;
  989.       if FastVars.Screen[0]^.Window.Y2 > 25 then
  990.          ResetWindow;
  991.       ActivateVirtualScreen(0);
  992.    end;
  993. end; { Set25 }
  994.  
  995. procedure SetBlinking(On:boolean);
  996. {}
  997. var Regs: registers;
  998. begin
  999.    with Regs do
  1000.    begin
  1001.       Ah := $10;
  1002.       Al := $03;
  1003.       if On then
  1004.          Bl := 01
  1005.       else
  1006.          Bl := 00;
  1007.    end;
  1008.    Intr($10,Regs);
  1009. end; { SetBlinking }
  1010.  
  1011.                            {*******************}
  1012.                            {**  Scroll Bars  **}
  1013.                            {*******************}
  1014.  
  1015. procedure SetScrollChars(U,D,L,R,E,B:char);
  1016. {}
  1017. begin
  1018.    with FastVars do
  1019.    begin
  1020.       UpArrowChar := U;
  1021.       DownArrowChar := D;
  1022.       LeftArrowChar := L;
  1023.       RightArrowChar := R;
  1024.       ElevatorChar := E;
  1025.       BackgroundChar := B;
  1026.    end;
  1027. end;  { SetScrollChars }
  1028.  
  1029. procedure SetScrollDefaults;
  1030. {}
  1031. begin
  1032.    SetScrollChars('','',char(27),char(26),'','░');
  1033. end;  { SetScrollDefaults }
  1034.  
  1035. function GetHScrollBarElevator(X1,X2:byte;Current,Max:longint) : byte;
  1036. {Returns the Y coordinate of the Elevator position}
  1037. var X,LineLength: integer;
  1038. begin
  1039.    if Current > Max then
  1040.       Current := Max;
  1041.    if (Current > 0) and (Max >= Current) then
  1042.    begin
  1043.      LineLength := X2 - succ(X1);
  1044.      if LineLength > 0 then
  1045.      begin
  1046.         if Current >= Max then
  1047.            X := pred(X2)
  1048.         else
  1049.         begin
  1050.            X := (Current * LineLength) div Max;
  1051.            if (X <= 0) or (Current = 1) then
  1052.               X := succ(X1)
  1053.            else
  1054.               inc(X,succ(X1));
  1055.         end;
  1056.      end else
  1057.         X := 0;
  1058.    end else
  1059.       X := 0;
  1060.    GetHScrollBarElevator := X;
  1061. end; { GetHScrollBarElevator }
  1062.  
  1063. procedure WriteHScrollBar(X1,X2,Y,FB: byte; Current,Max: longint);
  1064. {}
  1065. var X,LineLength: integer;
  1066. begin
  1067.    if Current > Max then
  1068.       Current := Max;
  1069.    WriteAT(X1,Y,FB,FastVars.LeftArrowChar);
  1070.    WriteAT(X2,Y,FB,FastVars.RightArrowChar);
  1071.    WriteAT(succ(X1),Y,FB,replicate(pred(X2-X1),FastVars.BackgroundChar));
  1072.    if (Current > 0) and (Max >= Current) then
  1073.    begin
  1074.       LineLength := X2 - succ(X1);
  1075.       if LineLength > 0 then
  1076.       begin
  1077.          X := (Current * LineLength) div Max;
  1078.          if Current >= Max then
  1079.             X := pred(LineLength);
  1080.          if (X < 0) or (Current = 1) then
  1081.             X := 0;
  1082.          WriteAT(succ(X1) + X,Y,FB,FastVars.ElevatorChar);
  1083.       end;
  1084.    end;
  1085. end; { WriteHScrollBar }
  1086.  
  1087. function GetVScrollBarElevator(Y1,Y2:byte;Current,Max:longint) : byte;
  1088. {Returns the Y coordinate of the Elevator position}
  1089. var Y,LineLength: integer;
  1090. begin
  1091.    if Current > Max then
  1092.       Current := Max;
  1093.    if (Current > 0) and (Max >= Current) then
  1094.    begin
  1095.      LineLength := Y2 - succ(Y1);
  1096.      if LineLength > 0 then
  1097.      begin
  1098.         if Current >= Max then
  1099.            Y := pred(Y2)
  1100.         else
  1101.         begin
  1102.            Y := (Current * LineLength) div Max;
  1103.            if (Y <= 0) or (Current = 1) then
  1104.               Y := succ(Y1)
  1105.            else
  1106.               inc(Y,succ(Y1));
  1107.         end;
  1108.      end else
  1109.         Y := 0;
  1110.    end else
  1111.       Y := 0;
  1112.    GetVScrollBarElevator := Y;
  1113. end; { GetVScrollBarElevator }
  1114.  
  1115. procedure WriteVScrollBar(X,Y1,Y2,FB: byte; Current,Max: longint);
  1116. {}
  1117. var I,Y: integer;
  1118. begin
  1119.    WriteAT(X,Y1,FB,FastVars.UpArrowChar);
  1120.    WriteAT(X,Y2,FB,FastVars.DownArrowChar);
  1121.    for I := succ(Y1) to pred(Y2) do
  1122.       WriteAT(X,I,FB,FastVars.BackgroundChar);
  1123.    Y := GetVScrollBarElevator(Y1,Y2,Current,Max);
  1124.    if Y <> 0 then
  1125.       WriteAT(X,Y,FB,FastVars.ElevatorChar);
  1126. end; { WriteVScrollBar }
  1127.  
  1128.                            {********************}
  1129.                            {**  Push Buttons  **}
  1130.                            {********************}
  1131.  
  1132. procedure DrawButton(X1,X2,Y,HiFB,FB:byte; Str:string);
  1133. {}
  1134. var SF,A,X: byte;
  1135. begin
  1136.    WriteAt(X1,Y,FB,replicate(succ(X2-X1),' '));
  1137.    (*
  1138.    SF :=  (X2 - X1 + 1 - length(Strip('A',HiMarker,Str)));
  1139.    if SF <> 0 then
  1140.       X := X1 +  SF div 2
  1141.    else
  1142.    *)
  1143.       X := X1;
  1144.    WriteHi(X,Y,HiFB,FB,Str);
  1145.    {draw button shadow effect}
  1146.    if ColorScreen then
  1147.       SF := CAttr(black,BAttr(ReadAttr(succ(X1),succ(Y))))
  1148.    else
  1149.       SF := CAttr(darkgray,BAttr(ReadAttr(succ(X1),succ(Y))));
  1150.    WriteAT(succ(X1),succ(Y),SF,replicate(succ(X2-X1),char(223)));
  1151.    WriteAT(succ(X2),Y,SF,char(220));
  1152. end; { DrawButton }
  1153.  
  1154. procedure DrawButtonDown(X1,X2,Y,HiFB,FB:byte; Str:string);
  1155. {}
  1156. var SF,SB,A,X: byte;
  1157. begin
  1158.    WriteAt(succ(X1),Y,FB,replicate(succ(X2-X1),' '));
  1159.    X := succ(X1) + (X2 - X1 + 1 - length(Strip('A',HiMarker,Str))) div 2 ;
  1160.    WriteHi(X,Y,HiFB,FB,Str);
  1161.    FB := ReadAttr(succ(X1),succ(Y));
  1162.    WriteAT(succ(X1),succ(Y),FB,replicate(succ(X2-X1),' '));
  1163.    WriteAT(X1,Y,FB,' ');
  1164. end; { DrawButtonDown }
  1165.  
  1166.                               {*************}
  1167.                               {**  Other  **}
  1168.                               {*************}
  1169. {$IFOPT F-}
  1170.    {$DEFINE FOFF}
  1171.    {$F+}
  1172. {$ENDIF}
  1173. procedure GoldExitRoutine;
  1174. {}
  1175. begin
  1176.    ExitProc := FastVars.ExitChain;
  1177.    {$IFNDEF NOVGACHARS}
  1178.        RemoveCustomChars;
  1179.    {$ENDIF}
  1180. end; { ExitRoutine }
  1181. {$IFDEF FOFF}
  1182.    {$F-}
  1183.    {$UNDEF FOFF}
  1184. {$ENDIF}
  1185.  
  1186. procedure ResetStartUpMode;
  1187. {resets monitor mode and cursor settings to the state they
  1188.  were in at program startup}
  1189. begin
  1190.     with FastVars do
  1191.     begin
  1192.        TextMode(StartMode);
  1193.        CursorSize(StartTop,StartBot);
  1194.        FastVars.CustomCharsActive := false;
  1195.     end;
  1196. end; { ResetStartUpMode }
  1197. {$ENDIF} {NOVGACHARS}
  1198.  
  1199. {$IFOPT F-}
  1200.    {$DEFINE FOFF}
  1201.    {$F+}
  1202. {$ENDIF}
  1203. function FastEMsg(ECode:integer): string;
  1204. {}
  1205. begin
  1206.    case Ecode of
  1207.       1001: FastEMsg := 'Insufficient memory to initialize program';
  1208.       1002: FastEMsg := 'Virtual page allocation error';
  1209.       else
  1210.          FastEMsg := 'Internal Fast error';
  1211.    end; {case}
  1212. end; { FastEMsg }
  1213. {$IFDEF FOFF}
  1214.    {$F-}
  1215.    {$UNDEF FOFF}
  1216. {$ENDIF}
  1217.  
  1218. procedure FastSetError(ECode:integer);
  1219. {}
  1220. {$IFOPT D+}
  1221. var Ch: char;
  1222.     Msg: string;
  1223. {$ENDIF}
  1224. begin
  1225.    FastVars.Ecode := ECode;
  1226. {$IFOPT D+}  {if debug active display an error message and terminate}
  1227.    if Ecode <> 0 then
  1228.    begin
  1229.       str(Ecode,Msg);
  1230.       Msg := Msg+': '+FastVars.EMsgFunc(Ecode);
  1231.       writeln(' GoldFast Error - ',Msg);
  1232.       Halt;
  1233.    end;
  1234. {$ENDIF}
  1235. end; { FastSetError }
  1236.  
  1237. function LastFastError: integer;
  1238. {}
  1239. begin
  1240.    LastFastError := FastVars.ECode;
  1241. end; { LastFastError }
  1242.  
  1243.                       {******************************}
  1244.                       {**  Miscellaneous Routines  **}
  1245.                       {******************************}
  1246.  
  1247.  
  1248. function OnScreen:boolean;
  1249. {}
  1250. begin
  1251.    OnScreen := FastVars.ActiveScreen = 0;
  1252. end; { OnScreen }
  1253.  
  1254.                       {*****************************}
  1255.                       {**  External/ASM Routines  **}
  1256.                       {*****************************}
  1257.  
  1258. {$IFOPT F-}
  1259.    {$DEFINE FOFF}
  1260.    {$F+}
  1261. {$ENDIF}
  1262.  
  1263. {$L GOLD}
  1264.   procedure WinWrite(var WinImage; Width,X1,Y2,X2,Y2,X3,Y3,Attr:byte; st:String;WWIgnore:byte); external;
  1265.   procedure WinPlain(var WinImage; Width,X1,Y2,X2,Y2,X3,Y3,Attr:byte; st:String;WWIgnore:byte); external;
  1266.   procedure WinAttr(var WinImage; Width,X1,Y2,X2,Y2,X3,Y3,X4,Y4,Attr:byte;WWIgnore:byte); external;
  1267.   procedure WinRedraw(MakeVisible:boolean); external;
  1268.   procedure MoveToScreen(SourceY1,SourceX1,SourceY2,SourceX2,SourceWidth:byte;var SourcePtr;
  1269.                          TargetX,TargetY,TargetWidth:byte;var TargetPtr); external;
  1270.   procedure MoveFromScreen(X1,Y1,X2,Y2,SourceWidth:byte; var SourcePtr, TargetPtr); external;
  1271.   procedure TopWinRedraw; external;
  1272.   procedure FillVideo(var Buffer; Count:word; Info:VideoWord); external;
  1273.   function  Different(var Source1,Source2;Size:word):boolean; external;
  1274. {$IFDEF FOFF}
  1275.    {$F-}
  1276.    {$UNDEF FOFF}
  1277. {$ENDIF}
  1278.  
  1279.                          {***********************}
  1280.                          {**  Cursor Routines  **}
  1281.                          {***********************}
  1282.  
  1283. procedure CursorFind(var X,Y,Top,Bot:byte);
  1284. {updates instance with visible Cursor details}
  1285. var Regs: registers;
  1286. begin
  1287.    if (VideoTarget.TargetType = WinTarget) then
  1288.    begin
  1289.       X := WStructurePtr(VideoTarget.TargetPtr)^.Cursor.X;
  1290.       Y := WStructurePtr(VideoTarget.TargetPtr)^.Cursor.Y;
  1291.       Top := WStructurePtr(VideoTarget.TargetPtr)^.Cursor.Top;
  1292.       Bot := WStructurePtr(VideoTarget.TargetPtr)^.Cursor.Bot;
  1293.    end else
  1294.    if OnScreen then
  1295.    begin
  1296.       with Regs do
  1297.       begin
  1298.          Ax := $0F00; {get page in Bx}
  1299.          intr($10,Regs);
  1300.          Ax := $0300;
  1301.          intr($10,Regs);
  1302.          X := lo(Dx) + 1;
  1303.          Y := hi(Dx) + 1;
  1304.          Top := hi(Cx) and $0F;
  1305.          Bot := lo(Cx) and $0F;
  1306.       end;
  1307.    end else
  1308.    with FastVars.Screen[FastVars.ActiveScreen]^ do
  1309.    begin
  1310.       X := CursorX;
  1311.       Y := CursorY;
  1312.       Top := ScanTop;
  1313.       Bot := ScanBot;
  1314.    end;
  1315. end; { CursorFind }
  1316.  
  1317. procedure AbsGotoXY(X,Y : byte);
  1318. {Uses BIOS to move the cursor, ignoring any window settings}
  1319. var Regs: registers;
  1320. begin
  1321.    with Regs do
  1322.    begin
  1323.       Ah := 2;
  1324.       Dh := pred(Y);
  1325.       Dl := pred(X);
  1326.       Bh := 0;
  1327.    end;
  1328.    intr($10,Regs);
  1329. end; { AbsGotoXY }
  1330.  
  1331. procedure GotoXY(X,Y : byte);
  1332. {Positions cursor on display, in window, or on virtual screen}
  1333. var X1,Y1:integer;
  1334. begin
  1335.    if (VideoTarget.TargetType = WinTarget) then
  1336.    begin
  1337.       WStructurePtr(VideoTarget.TargetPtr)^.Cursor.X := X;
  1338.       WStructurePtr(VideoTarget.TargetPtr)^.Cursor.Y := Y;
  1339.       if VideoTarget.MoveCursor then
  1340.       begin
  1341.          X1 := WStructurePtr(VideoTarget.TargetPtr)^.X +pred(X);
  1342.          if VideoTarget.WindowActive then
  1343.             inc(X1,pred(VideoTarget.WX1));
  1344.          Y1 := WStructurePtr(VideoTarget.TargetPtr)^.Y +pred(Y);
  1345.          if VideoTarget.WindowActive then
  1346.             inc(Y1,pred(VideoTarget.WY1));
  1347.          if  (X1 >= 1) and (X1 <= HardVars.Width)
  1348.          and (Y1 >= 1) and (Y1 <= HardVars.Depth) then
  1349.             AbsGotoXY(X1,Y1)
  1350.          else
  1351.             CursorAbsSize(0,0);  {if cursor would be off screen, hide it}
  1352.       end;
  1353.    end else
  1354.    if VideoTarget.MoveCursor then  {visible screen is active}
  1355.    begin
  1356.       if VideoTarget.WindowActive then
  1357.          AbsGotoXY(X+pred(VideoTarget.WX1),Y+pred(VideoTarget.WY1))
  1358.       else
  1359.          AbsGotoXY(X,Y);
  1360.    end else  {virtual screen - windows are ignored}
  1361.    with FastVars.Screen[FastVars.ActiveScreen]^ do
  1362.    begin
  1363.       CursorX := X;
  1364.       CursorY := Y;
  1365.    end; {with}
  1366. end; { GotoXY }
  1367.  
  1368. procedure AbsWhereXY(var X,Y:byte);
  1369. {Uses BIOS to get the cursor position, ignoring any window settings}
  1370. var Regs: registers;
  1371. begin
  1372.    with Regs do
  1373.    begin
  1374.       Ah := 3;
  1375.       Bh := 0;
  1376.       intr($10,Regs);
  1377.       Y := succ(Dh);
  1378.       X := succ(Dl);
  1379.    end;
  1380. end; { AbsWhereXY }
  1381.  
  1382. function WhereX: byte;
  1383. {Returns the cursor position, on screen, in window or on virtual screen}
  1384. var X1,Y1: byte;
  1385. begin
  1386.    if (VideoTarget.TargetType = WinTarget) then
  1387.       WhereX := WStructurePtr(VideoTarget.TargetPtr)^.Cursor.X
  1388.    else if VideoTarget.MoveCursor then  {visible screen is active}
  1389.    begin
  1390.       AbsWhereXY(X1,Y1);
  1391.       if VideoTarget.WindowActive then
  1392.          WhereX := X1 + pred(VideoTarget.WX1)
  1393.       else
  1394.          WhereX := X1;
  1395.    end else
  1396.       WhereX := FastVars.Screen[FastVars.ActiveScreen]^.CursorX;
  1397. end; { WhereX }
  1398.  
  1399. function WhereY: byte;
  1400. {Returns the cursor position, on screen, in window or on virtual screen}
  1401. var X1,Y1: byte;
  1402. begin
  1403.    if (VideoTarget.TargetType = WinTarget) then
  1404.       WhereY := WStructurePtr(VideoTarget.TargetPtr)^.Cursor.Y
  1405.    else if VideoTarget.MoveCursor then  {visible screen is active}
  1406.    begin
  1407.       AbsWhereXY(X1,Y1);
  1408.       if VideoTarget.WindowActive then
  1409.          WhereY := Y1 + pred(VideoTarget.WY1)
  1410.       else
  1411.          WhereY := Y1;
  1412.    end else
  1413.       WhereY := FastVars.Screen[FastVars.ActiveScreen]^.CursorY;
  1414. end; { WhereY }
  1415.  
  1416. procedure CursorAbsSize(T,B:byte);
  1417. {Sets the scan lines for the cursor regardless of active screen/window}
  1418. var Regs: registers;
  1419. begin
  1420.    with Regs do
  1421.    begin
  1422.       AX := $0100;
  1423.       if (T=0) and (B=0) then
  1424.          CX := $2020
  1425.       else
  1426.       begin
  1427.       (*
  1428.       If you have an odd video bios and cursor changes
  1429.       are strange, enable this next line.
  1430.          mem[$40:$87] := mem[$40:$87] or $01; {get cursor ownership from BIOS}
  1431.       *)
  1432.          Ch := T;
  1433.          Cl := B;
  1434.       end;
  1435.       intr($10,Regs);
  1436.    end;
  1437. end; { CursorAbsSize }
  1438.  
  1439. procedure CursorPos(X,Y: integer);
  1440. {}
  1441. begin
  1442.    if OnScreen then    {visible screen is active}
  1443.       AbsGotoXY(X,Y)
  1444.    else
  1445.    with FastVars.Screen[FastVars.ActiveScreen]^ do
  1446.    begin
  1447.       CursorX := X;
  1448.       CursorY := Y;
  1449.    end; {with}
  1450. end; { PosCursor }
  1451.  
  1452. procedure CursorSize(T,B:byte);
  1453. {}
  1454. var X1,Y1: integer;
  1455. begin
  1456.    if (VideoTarget.TargetType = WinTarget) then
  1457.    begin
  1458.       WStructurePtr(VideoTarget.TargetPtr)^.Cursor.Top := T;
  1459.       WStructurePtr(VideoTarget.TargetPtr)^.Cursor.Bot := B;
  1460.       if VideoTarget.MoveCursor then
  1461.       begin
  1462.          {check to see if cursor is on screen}
  1463.          X1 := WStructurePtr(VideoTarget.TargetPtr)^.X
  1464.              + pred(WStructurePtr(VideoTarget.TargetPtr)^.Cursor.X);
  1465.          if VideoTarget.WindowActive then
  1466.             inc(X1,pred(VideoTarget.WX1));
  1467.          Y1 := WStructurePtr(VideoTarget.TargetPtr)^.Y
  1468.              + pred(WStructurePtr(VideoTarget.TargetPtr)^.Cursor.Y);
  1469.          if VideoTarget.WindowActive then
  1470.             inc(Y1,pred(VideoTarget.WY1));
  1471.          if  (X1 >= 1) and (X1 <= HardVars.Width)
  1472.          and (Y1 >= 1) and (Y1 <= HardVars.Depth) then
  1473.             CursorAbsSize(T,B);
  1474.        end;
  1475.    end else
  1476.    if VideoTarget.MoveCursor then  {visible screen is active}
  1477.       CursorAbsSize(T,B)
  1478.    else
  1479.      with FastVars.Screen[FastVars.ActiveScreen]^ do
  1480.      begin
  1481.         ScanTop := T;
  1482.         ScanBot := B;
  1483.      end;
  1484. end; { CursorSize }
  1485.  
  1486. function CharHeight: integer;
  1487. {get height of text mode characters for cursor manipulation}
  1488. var Regs: registers;
  1489. begin
  1490.    if OnScreen then
  1491.    begin
  1492.       case HardVars.DisplayType of
  1493.          Mono: CharHeight := 14;
  1494.          EGACol,
  1495.          CGA : CharHeight := 8;
  1496.       else
  1497.          with Regs do
  1498.          begin
  1499.             Ah := $11;
  1500.             Al := $30;
  1501.             BX := $0;
  1502.             Intr($10,Regs);
  1503.             CharHeight := CX;
  1504.          end; {with}
  1505.       end;  {case}
  1506.    end else        {virtual screen assume normal mode}
  1507.    begin
  1508.       if HardVars.DisplayType = Mono then
  1509.          CharHeight := 14
  1510.       else
  1511.          CharHeight := 8;
  1512.    end;
  1513. end; { CharHeight }
  1514.  
  1515. procedure CursorHalf;
  1516. {}
  1517. var Charsize: byte;
  1518. begin
  1519.    CharSize := CharHeight;
  1520.    CursorSize(CharSize div 2, pred(CharSize));
  1521. end; { CursorHalf }
  1522.  
  1523. procedure CursorFull;
  1524. {}
  1525. var Charsize: byte;
  1526. begin
  1527.    CharSize := CharHeight;
  1528.    CursorSize(0,CharSize);
  1529. end; { CursorFull }
  1530.  
  1531. procedure CursorOn;
  1532. {}
  1533. var Charsize: byte;
  1534. begin
  1535.    CharSize := CharHeight;
  1536.    CursorSize(CharSize-3, CharSize-2);
  1537. end; { CursorOn }
  1538.  
  1539. procedure CursorOff;
  1540. {}
  1541. begin
  1542.    CursorSize(0,0);
  1543. end; { CursorOff }
  1544.  
  1545.                          {***********************}
  1546.                          {**  Window Settings  **}
  1547.                          {***********************}
  1548.  
  1549. procedure SetWindow(X1,Y1,X2,Y2: byte);
  1550. {Sets the local Window coordinates for a screen or a window}
  1551.  
  1552.    procedure UpdateVideoTarget;
  1553.    {}
  1554.    begin
  1555.       VideoTarget.WX1 := X1;
  1556.       VideoTarget.WY1 := Y1;
  1557.       VideoTarget.WX2 := X2;
  1558.       VideoTarget.WY2 := Y2;
  1559.    end; { UpdateVideoTarget }
  1560.  
  1561. begin
  1562.    if  (X1 <= X2)
  1563.    and (X1 > 0)
  1564.    and (Y1 <= Y2)
  1565.    and (Y1 > 0) then     {window coords seem reasonable}
  1566.    begin
  1567.       if (VideoTarget.TargetType = WinTarget) then
  1568.       begin
  1569.          with WStructurePtr(VideoTarget.TargetPtr)^ do
  1570.          begin
  1571.             if (X2 <= Width)
  1572.             and (Y2 <= Depth) then
  1573.             begin
  1574.                WinX1 := X1;
  1575.                WinY1 := Y1;
  1576.                WinX2 := X2;
  1577.                WinY2 := Y2;
  1578.                UpdateVideoTarget;
  1579.             end;
  1580.          end; {with}
  1581.       end else
  1582.       begin
  1583.          with FastVars.Screen[FastVars.ActiveScreen]^ do
  1584.          begin
  1585.             if (X2 <= Width)
  1586.             and (Y2 <= Depth) then
  1587.             begin
  1588.                Window.X1 :=  X1;
  1589.                Window.Y1 :=  Y1;
  1590.                Window.X2 :=  X2;
  1591.                Window.Y2 :=  Y2;
  1592.                UpdateVideoTarget;
  1593.             end;
  1594.          end;
  1595.       end;
  1596.    end;
  1597. end; { SetWindow }
  1598.  
  1599. procedure ResetWindow;
  1600. {Sets the windows to the perimeter of the screen or window}
  1601. var D,W: byte;
  1602. begin
  1603.    if (VideoTarget.TargetType = WinTarget) then
  1604.    begin
  1605.       with WStructurePtr(VideoTarget.TargetPtr)^ do
  1606.       begin
  1607.          W := Width;
  1608.          D := Depth;
  1609.       end;
  1610.    end else
  1611.    if OnScreen then
  1612.    begin
  1613.       W := HardVars.Width;
  1614.       D := HardVars.Depth;
  1615.    end else
  1616.    begin
  1617.       W := FastVars.Screen[FastVars.ActiveScreen]^.Width;
  1618.       D := FastVars.Screen[FastVars.ActiveScreen]^.Depth;
  1619.    end;
  1620.    SetWindow(1,1,W,D);
  1621. end; { ResetWindow }
  1622.  
  1623. procedure SetWinIgnore(On:Boolean);
  1624. {}
  1625. begin
  1626.    if (VideoTarget.TargetType = WinTarget) then
  1627.       SetBitStatus(WStructurePtr(VideoTarget.TargetPtr)^.WinState,WinConfine,not On)
  1628.    else
  1629.       FastVars.Screen[FastVars.ActiveScreen]^.WindowIgnore := On;
  1630.    VideoTarget.WindowActive := not On;
  1631. end; { SetWinIgnore }
  1632.  
  1633. function GetSetWinIgnore(On:Boolean):boolean;
  1634. {}
  1635. begin
  1636.    if (VideoTarget.TargetType = WinTarget) then
  1637.       GetSetWinIgnore := not GetBitStatus(WStructurePtr(VideoTarget.TargetPtr)^.WinState,WinConfine)
  1638.    else
  1639.       GetSetWinIgnore := FastVars.Screen[FastVars.ActiveScreen]^.WindowIgnore;
  1640.    SetWinIgnore(On);
  1641. end; { GetSetWinIgnore }
  1642.  
  1643.                         {*************************}
  1644.                         {**  Screen Management  **}
  1645.                         {*************************}
  1646.  
  1647. procedure ActivateVirtualScreen(Page:word);
  1648. {Page of nil signifies the visible screen}
  1649. begin
  1650.    if Page = 0 then
  1651.       FastVars.ActiveScreen := 0
  1652.    else if (Page <= MaxVScreens) and (FastVars.Screen[Page] <> nil) then
  1653.       FastVars.ActiveScreen := Page
  1654.    else
  1655.       exit;
  1656.    with VideoTarget do
  1657.    begin
  1658.       ScreenPtr := FastVars.Screen[Page]^.ScreenPtr;
  1659.       Width := FastVars.Screen[Page]^.Width;
  1660.       Depth := FastVars.Screen[Page]^.Depth;
  1661.       WX1 := FastVars.Screen[Page]^.Window.X1;
  1662.       WY1 := FastVars.Screen[Page]^.Window.Y1;
  1663.       WX2 := FastVars.Screen[Page]^.Window.X2;
  1664.       WY2 := FastVars.Screen[Page]^.Window.Y2;
  1665.       with FastVars.Screen[Page]^ do
  1666.          WindowActive := (WindowIgnore = false);
  1667.       TargetType := ScreenTarget;
  1668.       TargetPtr := FastVars.Screen[Page];
  1669.       MoveCursor := Page = 0;
  1670.    end;
  1671. end; { ActivateVirtualScreen }
  1672.  
  1673. procedure ActivateBackground;
  1674. {Directs all screen writing to the background when at least one
  1675.  window is active. To make the write's visible, you must call WinDrawAll
  1676.  having updated the background}
  1677. begin
  1678.    if BackBuffer <> nil then
  1679.    begin
  1680.       with VideoTarget do
  1681.       begin
  1682.          ScreenPtr := BackBuffer;
  1683.          Width := HardVars.Width;
  1684.          Depth := HardVars.Depth;
  1685.          WX1 := 1;
  1686.          WY1 := 1;
  1687.          WX2 := Width;
  1688.          WY2 := Depth;
  1689.          TargetType := ScreenTarget;
  1690.          TargetPtr := nil;
  1691.          MoveCursor := false;
  1692.       end;
  1693.    end;
  1694. end; { ActivateBackground }
  1695.  
  1696. procedure ActivateVisibleScreen;
  1697. {}
  1698. begin
  1699.    ActivateVirtualScreen(0);
  1700. end; { ActivateVisibleScreen }
  1701.  
  1702. procedure AllocateVirtualScreen(Page,X,Y:byte);
  1703. {INTERNAL - called by CreateScreen and SaveScreen}
  1704. begin
  1705.    {if there is already a saved screen of different dimensions - get rid of it}
  1706.    if  ((FastVars.Screen[Page] <> nil)
  1707.    and (   X*Y
  1708.            <>
  1709.            FastVars.Screen[Page]^.Depth * FastVars.Screen[Page]^.Width)
  1710.        ) then
  1711.       DisposeScreen(Page);
  1712.    if FastVars.Screen[Page] = nil then            {need to allocate memory}
  1713.    begin
  1714.       if GoldMaxAvail > sizeof(FastVars.Screen[Page]^) then
  1715.       begin
  1716.          getmem(FastVars.Screen[Page],sizeof(FastVars.Screen[Page]^));
  1717.          if GoldMaxAvail < X*Y*2 then
  1718.          begin
  1719.             {some memory error}
  1720.             freemem(FastVars.Screen[Page],sizeof(FastVars.Screen[Page]^));
  1721.             FastVars.Screen[Page] := nil;
  1722.             FastSetError(1002);
  1723.          end;
  1724.          if Page <> 0 then
  1725.             getmem(FastVars.Screen[Page]^.ScreenPtr,X*Y*2);
  1726.       end else
  1727.          FastSetError(1001);
  1728.    end;
  1729. end; { AllocateVirtualScreen }
  1730.  
  1731. procedure CreateScreen(Page,X,Y,FB:byte);
  1732. {}
  1733. var OriginalTarget:VideoZone;
  1734.     Attr:byte;
  1735. begin
  1736.    if (Page <= MaxVScreens) then
  1737.    begin
  1738.       AllocateVirtualScreen(Page,X,Y);
  1739.       if FastVars.Screen[Page] <> nil then
  1740.       begin
  1741.          with FastVars.Screen[Page]^ do
  1742.          begin
  1743.             CursorFind(CursorX,CursorY,ScanTop,ScanBot);  {Save Cursor posn. and shape}
  1744.             Depth := Y;
  1745.             Width := X;
  1746.             Window.X1 := 1;
  1747.             Window.Y1 := 1;
  1748.             Window.X2 := X;
  1749.             Window.Y2 := Y;
  1750.             CursorX := 1;
  1751.             CursorY := 1;
  1752.             OriginalTarget := VideoTarget;
  1753.             ActivateVirtualScreen(Page);
  1754.             CursorOn;
  1755.             FillScreen(1,1,X,Y,FB,' ');
  1756.             VideoTarget := OriginalTarget;
  1757.          end;
  1758.       end;
  1759.    end;
  1760. end; { CreateScreen }
  1761.  
  1762. procedure SaveScreen(Page:byte);
  1763. {Save screen image and cursor details}
  1764. var MVisible: boolean;
  1765. begin
  1766.    if (Page <= MaxVScreens) then
  1767.    begin
  1768.       AllocateVirtualScreen(Page,FastVars.Screen[0]^.Width,FastVars.Screen[0]^.Depth);
  1769.       with FastVars.Screen[Page]^ do
  1770.       begin
  1771.          CursorFind(CursorX,CursorY,ScanTop,ScanBot);  {save Cursor posn. and shape}
  1772.          {save window settings}
  1773.          Window := FastVars.Screen[0]^.Window;
  1774.          Depth := HardVars.Depth;
  1775.          Width := HardVars.Width;
  1776.          MVisible := KeyVars.MouseVisible;
  1777.          if MVisible then
  1778.             MouseShow(false);
  1779.          MoveFromScreen(1,1,Width,Depth,Width,HardVars.ScreenPtr^,ScreenPtr^);
  1780.          if MVisible then
  1781.             MouseShow(true);
  1782.       end;
  1783.    end;
  1784. end; { SaveScreen }
  1785.  
  1786. procedure PartRestoreScreen(Page,X1,Y1,X2,Y2,X,Y:byte);
  1787. {Move from heap to screen, part of saved screen}
  1788. var MVisible: boolean;
  1789. begin
  1790.    if FastVars.Screen[Page] <> nil then
  1791.    begin
  1792.       MVisible := KeyVars.MouseVisible;
  1793.       if MVisible then
  1794.          MouseShow(false);
  1795.       with FastVars.Screen[Page]^ do
  1796.          MoveToScreen(X1,Y1,X2,Y2,width,ScreenPtr^,X1,Y1,HardVars.Width,HardVars.ScreenPtr^);
  1797.       if MVisible then
  1798.          MouseShow(true);
  1799.    end;
  1800. end; { PartRestoreScreen }
  1801.  
  1802. procedure RestoreCursAndWin(Page:byte);
  1803. {INTERNAL}
  1804. begin
  1805.    ActivateVisibleScreen;
  1806.    with FastVars.Screen[Page]^ do
  1807.    begin
  1808.       CursorPos(CursorX,CursorY);
  1809.       CursorSize(ScanTop,ScanBot);
  1810.       with Window do
  1811.          SetWindow(X1,Y1,X2,Y2);
  1812.    end;
  1813. end; { RestoreCursAndWin }
  1814.  
  1815. procedure RestoreScreen(Page:byte);
  1816. {display a screen that was previously saved}
  1817. var Wid,Dep: integer;
  1818.     MVisible: boolean;
  1819. begin
  1820.     if  (Page > 0) and (Page <= MaxVScreens)
  1821.     and (FastVars.Screen[Page] <> nil) then
  1822.     begin
  1823.        MVisible := KeyVars.MouseVisible;
  1824.        if MVisible then
  1825.           MouseShow(false);
  1826.        if HardVars.Width = FastVars.Screen[Page]^.Width then {one big move}
  1827.           with FastVars.Screen[Page]^ do
  1828.              MoveToScreen(1,1,width,depth,width,ScreenPtr^,1,1,HardVars.Width,HardVars.ScreenPtr^)
  1829.        else
  1830.        begin
  1831.           Wid := HardVars.Width;
  1832.           if Wid >= FastVars.Screen[Page]^.Width then
  1833.              Wid := FastVars.Screen[Page]^.Width;
  1834.           Dep := HardVars.Width;
  1835.           if Dep >= FastVars.Screen[Page]^.Depth then
  1836.              Dep := FastVars.Screen[Page]^.Depth;
  1837.           PartRestoreScreen(Page,1,1,Wid,Dep,1,1);
  1838.        end;
  1839.        if MVisible then
  1840.           MouseShow(true);
  1841.        RestoreCursAndWin(Page);
  1842.     end;
  1843. end; { RestoreScreen }
  1844.  
  1845. procedure PartSlideRestoreScreen(Page:byte;Way:gDirection;X1,Y1,X2,Y2:byte);
  1846. {}
  1847. var I: integer;
  1848. begin
  1849.    case Way of
  1850.       Up:begin
  1851.             for I := Y2 downto Y1 do
  1852.             begin
  1853.                PartRestoreScreen(Page,X1,Y1,X2,Y1+Y2-I,X1,I);
  1854.                Delay(25);
  1855.             end;
  1856.          end;
  1857.     Down:begin
  1858.             for I := Y1 to Y2 do
  1859.             begin
  1860.                PartRestoreScreen(Page,X1,Y1+Y2 -I,X2,Y2,X1,Y1);
  1861.                Delay(25);  {savor the moment!}
  1862.             end;
  1863.          end;
  1864.     Left:begin
  1865.             for I := X1 to X2 do
  1866.             begin
  1867.                PartRestoreScreen(Page,X1,Y1,I,Y2,X1+X2-I,Y1);
  1868.             end;
  1869.          end;
  1870.    Right:begin
  1871.             for I := X2 downto X1 do
  1872.             begin
  1873.                 PartRestoreScreen(Page,I,Y1,X2,Y2,X1,Y1);
  1874.             end;
  1875.          end;
  1876.     Vert:for I := Y1 to Y1 + (Y2 - Y1) div 2 do
  1877.          begin
  1878.             PartRestoreScreen(Page,X1,I,X2,I,X1,I);
  1879.             PartRestoreScreen(Page,X1,Y2+Y1-I,X2,Y2+Y1-I,X1,Y2+Y1-I);
  1880.             Delay(50);
  1881.          end;
  1882.    Horiz:for I := X1 to X1 + succ(X2 -X1) div 2 do
  1883.          begin
  1884.             PartRestoreScreen(Page,I,Y1,I,Y2,I,Y1);
  1885.             PartRestoreScreen(Page,(X2)+X1-I,Y1,(X2)+X1-I,Y2,(X2)+X1-I,Y1);
  1886.             Delay(10);
  1887.          end;
  1888.    end; {case}
  1889. end; { PartSlideRestoreScreen }
  1890.  
  1891. procedure SlideRestoreScreen(Page:byte;Way:gDirection);
  1892. {}
  1893. var WinCoords: gByteCoords;
  1894.     X,Y,Top,Bot : byte;
  1895.     MVisible: boolean;
  1896. begin
  1897.    X := HardVars.Width;
  1898.    if X > FastVars.Screen[Page]^.Width then
  1899.       X := FastVars.Screen[Page]^.Width;
  1900.    Y := HardVars.Depth;
  1901.    if Y > FastVars.Screen[Page]^.Depth then
  1902.       Y := FastVars.Screen[Page]^.Depth;
  1903.    MVisible := KeyVars.MouseVisible;
  1904.    if MVisible then
  1905.       MouseShow(false);
  1906.    PartSlideRestoreScreen(Page,Way,1,1,X,Y);
  1907.    if MVisible then
  1908.       MouseShow(true);
  1909.    with FastVars.Screen[Page]^ do
  1910.    begin
  1911.       CursorPos(CursorX,CursorY);
  1912.       CursorSize(ScanTop,ScanBot);
  1913.    end;
  1914.    {restore cursor details and window setting}
  1915.    RestoreCursAndWin(Page);
  1916. end; { SlideRestoreScreen }
  1917.  
  1918. procedure DisposeScreen(Page:byte);
  1919. {Free memory and set pointer to nil}
  1920. begin
  1921.    if (Page <= MaxVScreens) and (FastVars.Screen[Page] <> nil) then
  1922.    begin
  1923.       with FastVars.Screen[Page]^ do
  1924.          freemem(ScreenPtr,Width*Depth*2);
  1925.       freemem(FastVars.Screen[Page],sizeof(FastVars.Screen[Page]^));
  1926.       FastVars.Screen[Page] := nil;
  1927.       if FastVars.ActiveScreen = Page then
  1928.          ActivateVirtualScreen(0);
  1929.    end;
  1930. end; { DisposeScreen }
  1931.  
  1932. procedure PartSave (X1,Y1,X2,Y2:byte; var Dest);
  1933. {transfers data from active virtual screen to Dest}
  1934. var MVisible: boolean;
  1935. begin
  1936.    MVisible := KeyVars.MouseVisible;
  1937.    if MVisible then
  1938.       MouseShow(false);
  1939.    with VideoTarget do
  1940.       MoveFromScreen(X1,Y1,X2,Y2,Width,ScreenPtr^,Dest);
  1941.    if MVisible then
  1942.       MouseShow(true);
  1943. end; { PartSave }
  1944.  
  1945. procedure PartRestore (X1,Y1,X2,Y2:byte; var Source);
  1946. {restores data from Source and transfers to active virtual screen
  1947.  - used internally}
  1948. var  MVisible: boolean;
  1949. begin
  1950.    MVisible := KeyVars.MouseVisible;
  1951.    if MVisible then
  1952.       MouseShow(false);
  1953.    with VideoTarget do
  1954.       MoveToScreen(1,1,succ(X2-X1),succ(Y2-Y1),succ(X2-X1),Source,X1,Y1,width,ScreenPtr^);
  1955.    if MVisible then
  1956.       MouseShow(true);
  1957. end; { PartRestore }
  1958.  
  1959. procedure CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  1960. {copies text and attributes from one part of screen to another}
  1961. var S: word;
  1962.     SPtr: pointer;
  1963.     MVisible: boolean;
  1964. begin
  1965.    S := succ(Y2-Y1)*succ(X2-X1)*2;
  1966.    if GoldMaxAvail > S then
  1967.    begin
  1968.       MVisible := KeyVars.MouseVisible;
  1969.       if MVisible then
  1970.          MouseShow(false);
  1971.       getmem(SPtr,S);
  1972.       PartSave(X1,Y1,X2,Y2,SPtr^);
  1973.       PartRestore(X,Y,X+X2-X1,Y+Y2-Y1,SPtr^);
  1974.       freemem(Sptr,S);
  1975.       if MVisible then
  1976.          MouseShow(true);
  1977.    end;
  1978. end; { CopyScreenBlock }
  1979.  
  1980. procedure MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  1981. {Moves text and attributes from one part of screen to another,
  1982.  replacing with ReplaceChar}
  1983. const ReplaceChar = ' ';
  1984. var S: word;
  1985.     SPtr: pointer;
  1986.     I: Integer;
  1987.     ST: string;
  1988.     MVisible: boolean;
  1989. begin
  1990.    S := succ(Y2-Y1)*succ(X2-X1)*2;
  1991.    if GoldMaxAvail > S then
  1992.    begin
  1993.       MVisible := KeyVars.MouseVisible;
  1994.       if MVisible then
  1995.          MouseShow(false);
  1996.       getmem(SPtr,S);
  1997.       PartSave(X1,Y1,X2,Y2,SPtr^);
  1998.       St := Replicate(succ(X2-X1),ReplaceChar);
  1999.       for I := Y1 to Y2 do
  2000.           WritePlain(X1,I,St);
  2001.       PartRestore(X,Y,X+X2-X1,Y+Y2-Y1,SPtr^);
  2002.       freemem(Sptr,S);
  2003.       if MVisible then
  2004.          MouseShow(true);
  2005.    end;
  2006. end; { MoveScreenBlock }
  2007.  
  2008. procedure Scroll(Way:gDirection;X1,Y1,X2,Y2:byte);
  2009. {used for screen scrolling, uses Copy & WritePlain for speed}
  2010. const ReplaceChar = ' ';
  2011. var I: integer;
  2012. begin
  2013.     case Way of
  2014.        Up:begin
  2015.              CopyScreenBlock(X1,succ(Y1),X2,Y2,X1,Y1);
  2016.              WritePlain(X1,Y2,replicate(succ(X2-X1),ReplaceChar));
  2017.           end;
  2018.      Down:begin
  2019.              CopyScreenBlock(X1,Y1,X2,pred(Y2),X1,succ(Y1));
  2020.              WritePlain(X1,Y1,replicate(succ(X2-X1),ReplaceChar));
  2021.           end;
  2022.      Left:begin
  2023.              CopyScreenBlock(succ(X1),Y1,X2,Y2,X1,Y1);
  2024.              for I := Y1 to Y2 do
  2025.                  WritePlain(X2,I,ReplaceChar);
  2026.           end;
  2027.     Right:begin
  2028.              CopyScreenBlock(X1,Y1,pred(X2),Y2,succ(X1),Y1);
  2029.              for I := Y1 to Y2 do
  2030.                  WritePlain(X1,I,ReplaceChar);
  2031.           end;
  2032.    end; {case}
  2033. end; {Scroll}
  2034.  
  2035.                           {**********************}
  2036.                           {**  Screen Writing  **}
  2037.                           {**********************}
  2038.  
  2039. procedure WritePlain(X,Y:byte; St:string);
  2040. {}
  2041. var MVisible: boolean;
  2042.  
  2043.     procedure WriteIt;
  2044.     {}
  2045.     begin
  2046.        with VideoTarget do
  2047.        begin
  2048.           if not WindowActive then
  2049.              WinPlain(ScreenPtr^,Width,1,1,width,depth,X,Y,0,St,0)
  2050.           else
  2051.              WinPlain(ScreenPtr^,Width,WX1,WY1,WX2,WY2,X,Y,0,St,0);
  2052.        end;
  2053.     end; { WriteIt }
  2054.  
  2055. begin
  2056.    MVisible := OnScreen and KeyVars.MouseVisible;
  2057.    with FastVars.Screen[FastVars.ActiveScreen]^ do
  2058.    begin
  2059.       if MVisible and MouseInZone(X,Y,X+length(St),Y) then
  2060.       begin
  2061.          MouseShow(false);
  2062.          WriteIt;
  2063.          MouseShow(true);
  2064.       end else
  2065.          WriteIt;
  2066.    end;
  2067. end; { WritePlain }
  2068.  
  2069. procedure WriteAT(X,Y,FB:byte; St:string);
  2070. {}
  2071. var Attr: byte;
  2072.     MVisible: boolean;
  2073.  
  2074.     procedure WriteIt;
  2075.     {}
  2076.     begin
  2077.        with VideoTarget do
  2078.        begin
  2079.           if not WindowActive then
  2080.              WinWrite(ScreenPtr^,Width,1,1,width,depth,X,Y,FB,St,0)
  2081.           else
  2082.              WinWrite(ScreenPtr^,Width,WX1,WY1,WX2,WY2,X,Y,FB,St,0);
  2083.        end;
  2084.     end; { WriteIt }
  2085.  
  2086. begin
  2087.    if X = 0 then
  2088.    begin
  2089.       WriteCenter(Y,FB,St);
  2090.       exit;
  2091.    end else
  2092.    if Y = 0 then
  2093.    begin
  2094.       WriteMiddle(X,FB,St);
  2095.       exit;
  2096.    end;
  2097.    if FB = Plain then
  2098.       WritePlain(X,Y,St)
  2099.    else
  2100.    begin
  2101.       if (FB = 0) then
  2102.          FB := Tint[Fast];
  2103.       MVisible := OnScreen and KeyVars.MouseVisible;
  2104.       with FastVars.Screen[FastVars.ActiveScreen]^ do
  2105.       begin
  2106.          if MVisible and MouseInZone(X,Y,X+length(St),Y) then
  2107.          begin
  2108.             MouseShow(false);
  2109.             WriteIt;
  2110.             MouseShow(true);
  2111.          end else
  2112.             WriteIt;
  2113.       end;
  2114.    end;
  2115. end; { WriteAT }
  2116.  
  2117. procedure WinDrawAll;
  2118. {Turns off mouse and calls WinRedraw (ASM) }
  2119. begin
  2120.    if KeyVars.MouseVisible then
  2121.    begin
  2122.       MouseShow(false);
  2123.       WinRedraw(true);
  2124.       MouseShow(true);
  2125.    end else
  2126.       WinRedraw(true);
  2127.    FrontUpdated := true;
  2128. end; { WinDrawAll }
  2129.  
  2130. procedure WinDrawTop;
  2131. {Turns off mouse and calls TopWinRedraw (ASM) }
  2132. begin
  2133.    if not FrontUpdated then
  2134.       WinDrawAll
  2135.    else if KeyVars.MouseVisible then
  2136.    begin
  2137.       MouseShow(false);
  2138.       TopWinRedraw;
  2139.       MouseShow(true);
  2140.    end
  2141.    else
  2142.       TopWinRedraw;
  2143. end; { WinDrawTop }
  2144.  
  2145. procedure WriteCol(Col,Row:byte; St:string);
  2146. begin
  2147.    with FastVars do
  2148.       WriteAt(Col,Row,Tint[Fast],St);
  2149. end; { WriteCol }
  2150.  
  2151. procedure WriteCap(X,Y,FBCap,FB:byte;Str:string);
  2152. {Writes a string with the first capital letter in a different color}
  2153. var CapPos: byte;
  2154. begin
  2155.    if Str <> '' then
  2156.    begin
  2157.       WriteAt(X,Y,FB,Str);   {write whole string in default cols}
  2158.       CapPos := 1;
  2159.       while (CapPos <= length(Str))
  2160.       and ((Str[CapPos] in [#65..#90]) = false) do
  2161.          inc(CapPos);
  2162.       if CapPos <= length(Str) then
  2163.          WriteAt(X + pred(CapPos),Y,FBCap,Str[CapPos]);
  2164.    end;
  2165. end; { WriteCap }
  2166.  
  2167. procedure WriteHi(X,Y,HiFB,FB:byte;Str:string);
  2168. {}
  2169. var P: byte;
  2170.     Hi: boolean;
  2171.  
  2172.    procedure WriteBit(Str:string);
  2173.    begin
  2174.       if Hi then
  2175.          WriteAt(X,Y,HiFB,Str)
  2176.       else
  2177.          WriteAt(X,Y,FB,Str);
  2178.    end;  { WriteBit }
  2179.  
  2180. begin
  2181.    Hi := False;
  2182.    P := Pos(HiMarker,Str);
  2183.    while P <> 0 do
  2184.    begin
  2185.       if P > 1 then
  2186.          WriteBit(copy(Str,1,pred(P)));
  2187.       delete(Str,1,P);
  2188.       inc(X,pred(P));
  2189.       P := Pos(HiMarker,Str);
  2190.       Hi := not Hi;
  2191.    end;
  2192.    WriteBit(Str);
  2193. end; { WriteHi }
  2194.  
  2195. procedure WriteHiX2(X1,X2,Y,HiFB,FB:byte;Str:string);
  2196. {}
  2197. var
  2198.    P: byte;
  2199.    Hi: boolean;
  2200.    MaxWidth,
  2201.    CharCount: byte;
  2202.  
  2203.    procedure WriteBit(Str:string);
  2204.    begin
  2205.       if CharCount + length(Str) > MaxWidth then
  2206.          delete(Str,MaxWidth-CharCount,255);
  2207.       if Hi then
  2208.          WriteAt(X1,Y,HiFB,Str)
  2209.       else
  2210.          WriteAt(X1,Y,FB,Str);
  2211.    end;  { WriteBit }
  2212.  
  2213. begin
  2214.    Hi := False;
  2215.    MaxWidth := succ(X2-X1);
  2216.    CharCount := 0;
  2217.    P := Pos(HiMarker,Str);
  2218.    while P <> 0 do
  2219.    begin
  2220.       inc(CharCount,pred(P));
  2221.       if P > 1 then
  2222.          WriteBit(copy(Str,1,pred(P)));
  2223.       delete(Str,1,P);
  2224.       inc(X1,pred(P));
  2225.       P := Pos(HiMarker,Str);
  2226.       Hi := not Hi;
  2227.    end;
  2228.    WriteBit(Str);
  2229. end; { WriteHiX2 }
  2230.  
  2231. procedure WriteClick(X,Y,FB:byte;Str:string);
  2232. {writes text to the screen with a click!}
  2233. var I: integer;
  2234.     L : byte;
  2235. begin
  2236.    L := length(Str);
  2237.    if OnScreen then
  2238.       for I := L downto 1 do
  2239.       begin
  2240.          WriteAt(X,Y,FB,copy(Str,I,succ(L-I)));
  2241.          sound(500);delay(20);nosound;delay(30);
  2242.       end
  2243.    else
  2244.       WriteAt(X,Y,FB,Str); {don't click if not visible}
  2245. end; { WriteClick }
  2246.  
  2247. procedure WriteHiCenter(Y,HiFB,FB:byte;Str:string);
  2248. {}
  2249. var X: integer;
  2250.     TmpStr: string;
  2251. begin
  2252.    with VideoTarget do
  2253.    begin
  2254.       TmpStr := Strip('A',HiMarker,Str);
  2255.       if WindowActive then
  2256.          X := (succ(WX2-WX1) - length(TmpStr)) div 2
  2257.       else
  2258.          X :=  (Width - length(TmpStr)) div 2;
  2259.       inc(X);
  2260.       if (X < 1) or (X > WX2) then
  2261.         X := 1;
  2262.       WriteHi(X,Y,HiFB,FB,Str);
  2263.    end;
  2264. end; { WriteHiCenter }
  2265.  
  2266. procedure WriteCenter(Y,FB:byte;Str:string);
  2267. {}
  2268. var X: integer;
  2269. begin
  2270.    with VideoTarget do
  2271.    begin
  2272.       if WindowActive then
  2273.          X := (succ(WX2-WX1) - length(Str)) div 2
  2274.       else
  2275.          X :=  (Width - length(Str)) div 2;
  2276.       inc(X);
  2277.       if (X < 1) or (X > WX2) then
  2278.         X := 1;
  2279.       WriteAt(X,Y,FB,Str);
  2280.    end;
  2281. end; { WriteCenter }
  2282.  
  2283. procedure WriteMiddle(X,FB:byte;Str:string);
  2284. {}
  2285. var X1,Y1,X2,Y2: byte;
  2286.     Y: integer;
  2287. begin
  2288.    with VideoTarget do
  2289.    begin
  2290.       if WindowActive then
  2291.          Y := succ(WY2-WY1) div 2
  2292.       else
  2293.          Y :=  Depth div 2;
  2294.       if Y < 1 then
  2295.         Y := 1;
  2296.       WriteAt(X,Y,FB,Str);
  2297.    end;
  2298. end; { WriteMiddle }
  2299.  
  2300. procedure WriteBetween(X1,X2,Y,FB:byte;Str:string);
  2301. {}
  2302. var X: integer;
  2303. begin
  2304.    if length(Str) >= X2 - X1 + 1 then
  2305.       WriteAt(X1,Y,FB,Str)
  2306.    else
  2307.    begin
  2308.       X := X1 + (X2 - X1 + 1 - length(Str)) div 2 ;
  2309.       WriteAt(X,Y,FB,Str);
  2310.    end;
  2311. end; { WriteBetween }
  2312.  
  2313. procedure WriteRight(X,Y,FB:byte;Str:string);
  2314. {writes a right-justified string to the screen}
  2315. var X1: integer;
  2316. begin
  2317.    X1 := succ(X-length(Str));
  2318.    if X1 < 1 then
  2319.       WriteAT(1,Y,FB,last(pred(X),Str))
  2320.    else
  2321.       WriteAT(X1,Y,FB,Str);
  2322. end; { WriteRight }
  2323.  
  2324. procedure WriteVert(X,Y,FB:byte;Str:string);
  2325. {}
  2326. var L: byte;
  2327.     I: integer;
  2328. begin
  2329.    L := length(Str);
  2330.    with VideoTarget do
  2331.    begin
  2332.       if WindowActive then
  2333.       begin
  2334.          if L > succ(WY2-WY1) - Y then
  2335.             L := succ(WY2-WY1) - pred(Y);
  2336.       end else
  2337.       begin
  2338.          if L > Depth - pred(Y) then
  2339.             L := Depth - pred(Y);
  2340.       end;
  2341.    end;
  2342.    for I := 1 to L do
  2343.       WriteAt(X,Y-1+I,FB,Str[I]);
  2344. end; { WriteVert }
  2345.  
  2346. procedure WriteProgressEngine(X1,X2,Y:byte;PerCent:real;ShowPerCent:boolean);
  2347. {}
  2348. var PStr, TStr: StrScreen;
  2349. begin
  2350.    with FastVars do
  2351.    begin
  2352.       PStr := Replicate((round((X2-X1)*PerCent)),ProgChar1);
  2353.       TStr := Replicate(((X2-X1)-length(PStr)),ProgChar2);
  2354.       WriteAT(X1,Y,TINT[Progress1],PStr);
  2355.       WriteAT(X1+length(PStr),Y,TINT[Progress2],TStr);
  2356.       if ShowPerCent then
  2357.          WriteAT(X2+PerCentPad,Y,TINT[ProgressPercent],
  2358.                       PadRight(IntToStr(round(PerCent*100))+'%',4,' '));
  2359.    end;
  2360. end;
  2361.  
  2362. procedure WriteProgressLong(X1,X2,Y:byte;Part,Total:longint;ShowPerCent:boolean);
  2363. {}
  2364. var TmpLong: real;
  2365. begin
  2366.    if X2 > X1 then
  2367.    begin
  2368.       if Part > Total then
  2369.          Part := Total;
  2370.       TmpLong := (Part / Total);
  2371.       WriteProgressEngine(X1,X2,Y,TmpLong,ShowPerCent);
  2372.    end;
  2373. end; { WriteProgressLong }
  2374.  
  2375. procedure WriteProgressReal(X1,X2,Y:byte;Part,Total:extended;ShowPerCent:boolean);
  2376. {}
  2377. var TmpReal: real;
  2378. begin
  2379.    if X2 > X1 then
  2380.    begin
  2381.       if Part > Total then
  2382.          Part := Total;
  2383.       TmpReal := (Part / Total);
  2384.       WriteProgressEngine(X1,X2,Y,TmpReal,ShowPerCent);
  2385.    end;
  2386. end; { WriteProgressReal }
  2387.  
  2388. procedure Attrib(X1,Y1,X2,Y2,FB:byte);
  2389. {changes color attrib at specified coords}
  2390. begin
  2391.    with VideoTarget do
  2392.    if KeyVars.MouseVisible then
  2393.    begin
  2394.       MouseShow(false);
  2395.       if WindowActive then
  2396.          WinAttr(ScreenPtr^,Width,WX1,WY1,WX2,WY2,X1,Y1,X2,Y2,FB,0)
  2397.       else
  2398.          WinAttr(ScreenPtr^,Width,1,1,Width,Depth,X1,Y1,X2,Y2,FB,0);
  2399.       MouseShow(true);
  2400.    end else
  2401.    begin
  2402.       if WindowActive then
  2403.          WinAttr(ScreenPtr^,Width,WX1,WY1,WX2,WY2,X1,Y1,X2,Y2,FB,0)
  2404.       else
  2405.          WinAttr(ScreenPtr^,Width,1,1,Width,Depth,X1,Y1,X2,Y2,FB,0);
  2406.    end;
  2407. end; { Attrib }
  2408.  
  2409. procedure FillScreen(X1,Y1,X2,Y2:byte; FB:byte; C:char);
  2410. var I: integer;
  2411.     S: string;
  2412. begin
  2413.     S := Replicate(succ(X2-X1),C);
  2414.     for I := Y1 to Y2 do
  2415.        WriteAT(X1,I,FB,S);
  2416. end; { FillScreen }
  2417.  
  2418. procedure Clear(FB:byte; C:Char);
  2419. {}
  2420. begin
  2421.    with FastVars.Screen[FastVars.ActiveScreen]^ do
  2422.       FillScreen(1,1,Width,Depth,FB,C);
  2423. end; { Clear }
  2424.  
  2425. procedure PartClear(X1,Y1,X2,Y2:byte; FB:byte; C:char);
  2426. {}
  2427. begin
  2428.    FillScreen(X1,Y1,X2,Y2,FB,C);
  2429. end; { PartClear }
  2430.  
  2431. procedure ClearText(X1,Y1,X2,Y2,FB:byte);
  2432. {}
  2433. var I: integer;
  2434.     S: string;
  2435. begin
  2436.    FillScreen(X1,Y1,X2,Y2,FB,' ');
  2437. end; { ClearText }
  2438.  
  2439. procedure ClearLine(Y,FB:integer);
  2440. begin
  2441.    WriteAt(1,Y,FB,replicate(80,' '));
  2442. end; { ClearLine }
  2443.  
  2444.                           {**********************}
  2445.                           {**  Screen Reading  **}
  2446.                           {**********************}
  2447.  
  2448. procedure ReadWord(X,Y:byte;var Attr:byte; var Ch : char);
  2449. {INTERNAL = updates vars Attr and Ch with attribute and character
  2450.  bytes in screen location (X,Y) of the active screen}
  2451. type
  2452.   ScreenWordRec = record
  2453.      Ch   : char;
  2454.      Attr : byte;
  2455.   end;
  2456. var
  2457.    VisibleAdr: word;
  2458.    SW: ScreenWordRec;
  2459.    MVisible:boolean;
  2460. begin
  2461.    with VideoTarget do
  2462.    begin
  2463.       if WindowActive then
  2464.       begin
  2465.          inc(X,pred(WX1));
  2466.          inc(Y,pred(WY1));
  2467.       end;
  2468.       VisibleAdr := pred(Y)*Width*2 + pred(X)*2;
  2469.       MVisible := OnScreen and KeyVars.MouseVisible;
  2470.       if not WindowActive and MVisible and MouseInZone(X,Y,X,Y) then
  2471.       begin
  2472.          MouseShow(false);
  2473.          MoveFromScreen(X,Y,X,Y,Width,ScreenPtr^,SW);
  2474.          MouseShow(true);
  2475.       end else
  2476.          MoveFromScreen(X,Y,X,Y,Width,ScreenPtr^,SW);
  2477.       Attr := SW.Attr;
  2478.       Ch   := SW.Ch;
  2479.    end;
  2480. end; { ReadWord }
  2481.  
  2482. function ReadChar(X,Y:byte):char;
  2483. var A: byte;
  2484.     C: char;
  2485. begin
  2486.    ReadWord(X,Y,A,C);
  2487.    ReadChar := C;
  2488. end; { ReadChar }
  2489.  
  2490. function ReadAttr(X,Y:byte):byte;
  2491. var A: byte;
  2492.     C: char;
  2493. begin
  2494.    ReadWord(X,Y,A,C);
  2495.    ReadAttr := A;
  2496. end; { ReadAttr }
  2497.  
  2498. function ReadStr(X1,X2,Y:byte):string;
  2499. var I: integer;
  2500.     Str: string;
  2501. begin
  2502.    Str := '';
  2503.    for I := X1 to X2 do
  2504.        Str := Str + ReadChar(I,Y);
  2505.    ReadStr := Str;
  2506. end; { ReadStr }
  2507.  
  2508.               {*********************************************}
  2509.               {**  U N I T   I N I T I A L I Z A T I O N  **}
  2510.               {*********************************************}
  2511.  
  2512. procedure FastDefaultSettings;
  2513. {}
  2514. begin
  2515.    LineWrap := false;
  2516.    ShowNow  := false;
  2517.    ShadowType := 3;
  2518.    ShadowAttr := 7;
  2519.    BBTop := 0;
  2520.    BBBot := 0;
  2521.    with FastVars do
  2522.    begin
  2523.       GrowNoise := true;
  2524.       ProgChar1 := '█'; {219}
  2525.       ProgChar2 := '▒'; {177}
  2526.       PerCentPad := 1;
  2527.    end;
  2528. end; { FastDefaultSettings }
  2529.  
  2530. procedure GoldFastInit;
  2531. {}
  2532. var I: integer;
  2533. begin
  2534.    SnowProne := HardVars.DisplayType = CGA;
  2535.    ScreenLines := 25;
  2536.    WinList := nil;
  2537.    {$IFDEF DPMI}
  2538.       getmem(FrontBuffer,8000);
  2539.    {$ELSE}
  2540.       FrontBuffer := ptr($BA00,$0000);
  2541.    {$ENDIF}
  2542.    with FastVars do
  2543.    begin
  2544.       for I := 0 to MaxVScreens
  2545.          do Screen[I] := nil;
  2546.       ActiveScreen := 0;
  2547.       EMsgFunc := FastEMsg;
  2548.       AllocateVirtualScreen(0,80,25);
  2549.       StartMode := LastMode;
  2550.       ActivateVisibleScreen;
  2551.       CursorFind(StartX,StartY,StartTop,StartBot);
  2552.       with Screen[0]^ do
  2553.       begin
  2554.          ScreenPtr := HardVars.ScreenPtr;
  2555.          Width := 80;
  2556.          Depth := HardVars.Depth;
  2557.          Window.X1 := 1;
  2558.          Window.Y1 := 1;
  2559.          Window.X2 := 80;
  2560.          Window.Y2 := Depth;
  2561.          CursorX := 1;
  2562.          CursorY := 1;
  2563.          WindowIgnore := false;
  2564.       end;
  2565.       ActivateVisibleScreen;
  2566.       CustomCharsActive := false;
  2567.       ExitChain := ExitProc;
  2568.       ExitProc := @GoldExitRoutine;
  2569.    end;
  2570.    FastDefaultSettings;
  2571.    SetScrollDefaults;
  2572. end; { GoldFastInit }
  2573.  
  2574. {$IFDEF TTT5}
  2575. procedure PosCursor(X,Y: integer);
  2576. {}
  2577. begin
  2578.    CursorPos(X,Y);
  2579. end; { PosCursor }
  2580.  
  2581. procedure FastWrite(Col,Row,Attr:byte; St:StrScreen);
  2582. {included for TTT5 compatibility}
  2583. begin
  2584.    WriteAT(Col,Row,Attr,St);
  2585. end; { FastWrite }
  2586.  
  2587. procedure FWrite(St:StrScreen);
  2588. {included for TTT5 compatibility}
  2589. var Col,Row : byte;
  2590. begin
  2591.    Col := WhereX;
  2592.    Row := WhereY;
  2593.    Fastwrite(Col,Row,attr(FCol,BCol),St);
  2594.    GotoXY(Col+length(St),Row);
  2595. end; { FWrite }
  2596.  
  2597. procedure FWriteLN(St:StrScreen);
  2598. {included for TTT5 compatibility}
  2599. var Col,Row : byte;
  2600. begin
  2601.     Col := WhereX;
  2602.     Row := WhereY;
  2603.     Fastwrite(Col,Row,attr(FCol,BCol),St);
  2604.     GotoXY(1,succ(Row));
  2605. end; { FWriteLN }
  2606.  
  2607. function  EGAVGASystem: boolean;
  2608. {included for TTT5 compatibility}
  2609. var  Regs : registers;
  2610. begin
  2611.    with Regs do
  2612.    begin
  2613.       Ax := $1C00;
  2614.       Cx := 7;
  2615.       Intr($10,Regs);
  2616.       If Al = $1C then  {VGA}
  2617.       begin
  2618.          EGAVGASystem := true;
  2619.          exit;
  2620.       end;
  2621.       Ax := $1200;
  2622.       Bl := $32;
  2623.       Intr($10,Regs);
  2624.       If Al = $12 then {MCGA}
  2625.       begin
  2626.          EGAVGASystem := true;
  2627.          exit;
  2628.       end;
  2629.       Ah := $12;
  2630.       Bl := $10;
  2631.       Cx := $FFFF;
  2632.       Intr($10,Regs);
  2633.       EGAVGASystem := (Cx <> $FFFF);  {EGA}
  2634.    end; {with}
  2635. end; { EGAVGASystem }
  2636.  
  2637. procedure Reset_StartUp_Mode;
  2638. {included for TTT5 compatibility}
  2639. begin
  2640.    ResetStartUpMode;
  2641. end; { Reset_StartUp_Mode }
  2642.  
  2643. procedure SetCondensedLines;
  2644. {included for TTT5 compatibility}
  2645. begin
  2646.    SetCondensed;
  2647. end; { SetCondensedLines }
  2648.  
  2649. procedure Set25Lines;
  2650. {included for TTT5 compatibility}
  2651. begin
  2652.    Set25;
  2653. end; { Set25Lines }
  2654.  
  2655. procedure Activate_Visible_Screen;
  2656. {included for TTT5 compatibility}
  2657. begin
  2658.    ActivateVisibleScreen;
  2659. end; { Activate_Visible_Screen }
  2660.  
  2661. procedure Activate_Virtual_Screen(Page:byte);
  2662. {included for TTT5 compatibility}
  2663. begin
  2664.    ActivateVirtualScreen(Page);
  2665. end; { Activate_Virtual_Screen }
  2666.  
  2667. function  GetScreenChar(X,Y:byte):char;
  2668. {included for TTT5 compatibility}
  2669. begin
  2670.    GetScreenChar := ReadChar(X,Y);
  2671. end; { GetScreenChar }
  2672.  
  2673. function  GetScreenAttr(X,Y:byte):byte;
  2674. {included for TTT5 compatibility}
  2675. begin
  2676.    GetScreenAttr := ReadAttr(X,Y);
  2677. end; { GetScreenAttr }
  2678.  
  2679. procedure GetScreenStr(X1,X2,Y:byte;var  St:StrScreen);
  2680. {included for TTT5 compatibility}
  2681. begin
  2682.    St := ReadStr(X1,X2,Y);
  2683. end; { GetScreenStr }
  2684.  
  2685. procedure PlainWrite(X,Y:byte; St:string);
  2686. {}
  2687. begin
  2688.    WritePlain(X,Y,St);
  2689. end; { PlainWrite }
  2690.  
  2691. procedure FBAttrib(X1,Y1,X2,Y2,F,B:byte);
  2692. {}
  2693. begin
  2694.    Attrib(X1,Y1,X2,Y2,Cattr(F,B));
  2695. end; { FBAttrib }
  2696.  
  2697. procedure FBClickwrite(Col,Row,F,B:byte; St:StrScreen);
  2698. {}
  2699. begin
  2700.    WriteClick(Col,Row,Cattr(F,B),St);
  2701. end; { FBClickWrite }
  2702.  
  2703. procedure FBBox(X1,Y1,X2,Y2,F,B,boxtype:integer);
  2704. {}
  2705. begin
  2706.    Box(X1,Y1,X2,Y2,Cattr(F,B),boxtype);
  2707. end; { FBBox }
  2708.  
  2709. procedure FBFBox(X1,Y1,X2,Y2,F,B,boxtype:integer);
  2710. {}
  2711. begin
  2712.    FBox(X1,Y1,X2,Y2,Cattr(F,B),boxtype);
  2713. end; { FBFBox }
  2714.  
  2715. procedure FBGrowFBox(X1,Y1,X2,Y2,F,B,boxtype:integer);
  2716. {}
  2717. begin
  2718.    GrowFBox(X1,Y1,X2,Y2,Cattr(F,B),boxtype);
  2719. end; { FBGrowFBox }
  2720.  
  2721. procedure FBHorizLine(X1,X2,Y,F,B,lineType:byte);
  2722. {}
  2723. begin
  2724.    HorizLine(X1,X2,Y,Cattr(F,B),lineType);
  2725. end; { FBHorizLine }
  2726.  
  2727. procedure FBVertLine(X,Y1,Y2,F,B,lineType:byte);
  2728. {}
  2729. begin
  2730.    VertLine(X,Y1,Y2,Cattr(F,B),lineType);
  2731. end; { FBVertLine }
  2732.  
  2733. procedure FBClearText(x1,y1,x2,y2,F,B:integer);
  2734. {}
  2735. begin
  2736.    ClearText(x1,y1,x2,y2,Cattr(F,B));
  2737. end; { FBClearText }
  2738.  
  2739. procedure FBClearLine(Y,F,B:integer);
  2740. {}
  2741. begin
  2742.    ClearLine(Y,Cattr(F,B));
  2743. end; { FBClearLine }
  2744.  
  2745. procedure FBWriteAT(X,Y,F,B:integer; St:StrScreen);
  2746. {}
  2747. begin
  2748.    WriteAT(X,Y,Cattr(F,B),St);
  2749. end; { FBWriteAT }
  2750.  
  2751. procedure FBWriteBetween(X1,X2,Y,F,B:byte; St:StrScreen);
  2752. {}
  2753. begin
  2754.    WriteBetween(X1,X2,Y,Cattr(F,B),St);
  2755. end; { FBWriteBetween }
  2756.  
  2757. procedure FBWriteCenter(LineNO,F,B:integer; St:StrScreen);
  2758. {}
  2759. begin
  2760.    WriteCenter(LineNO,Cattr(F,B),St);
  2761. end; { FBWriteCenter }
  2762.  
  2763. procedure FBWriteVert(X,Y,F,B:integer; St:StrScreen);
  2764. {}
  2765. begin
  2766.    WriteVert(X,Y,Cattr(F,B),St);
  2767. end; { FBWriteVert }
  2768.  
  2769. procedure FBFillScreen(X1,Y1,X2,Y2:byte; F,B:byte; C:char);
  2770. {}
  2771. Begin
  2772.    FillScreen(X1,Y1,X2,Y2,Cattr(F,B),C);
  2773. End; { FBFillScreen }
  2774. {$ENDIF}
  2775.  
  2776. begin
  2777.    GoldFastInit;
  2778. end.
  2779.